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Abstract 


A  dynamic  model  simulates  the  short-  and  long-term  hydrologic  impacts  of  combinations 
of  timber  harvesting  and  weather  modification  to  develop  management  strategies  for 
planning  intervals  which  can  vary  from  a  few  years  to  the  rotation  age  of  subalpine  forests 
(120  years  and  longer).  Management  strategies  may  subdivide  a  given  "planning  unit," 
defined  by  environmental  characteristics,  into  as  many  as  eight  distinct  "response  units," 
which  may  be  managed  independently.  Different  cutting  practices  may  be  imposed  on  the 
response  units,  and  any  number  of  cuttings  can  be  made  at  specified  years  during  the 
planning  interval.  All  interactions  between  the  various  response  units  are  accounted  for  in 
both  time  and  space.  Moreover,  the  model  contains  time  trend  functions  which  compute 
changes  in  evapotranspiration,  soil  water,  forest  cover  density,  reflectivity,  interception, 
snow  redistribution,  and  sediment  yield  as  the  forest  stands  respond  to  timber  harvesting. 
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Land  Use  Simulation  Model  of  the  Subalpine 
Coniferous  Forest  Zone 


Charles  F.  Leaf  and  Glen  E.  Brink 


Introduction 

Conflicts  between  interest  groups  over  land-use 
impacts  on  the  environment  in  the  subalpine  zone 
cannot  be  resolved  without  objective  multi-resource 
analyses.  These  analyses  must  account  tor  both  pri- 
mary resource  responses  and  their  interactions. 
Dynamic  simulation  models  are  one  way  of  provid- 
ing the  framework  for  comprehensive  land-use 
planning  in  ecologically  complex  forests.  The 
output  from  such  models  should  help  planners  to 
better  understand  how  various  land-use  practices 
influence  productivity  and  environmental  quality. 
Moreover,  multi-resource  simulation  models  should 
help  to  achieve  the  most  desirable  balance  of  uses 
and  products  from  the  subalpine  coniferous  forest 
zone. 

Some  progress  has  been  made  in  the  development 
of  simulation  models  that  predict  the  short-term 
effects  of  timber  harvesting  on  snowmelt  and  water 
yield  (Leaf  and  Brink  1972,  1973a,  1973b,  Leaf 
1975).  This  work  has  been  expanded  to  determine 
the  long-term  interactions  between  the  water  and 
timber  resources  in  old-growth  subalpine  forests 
subjected  to  partial  cutting  and  regeneration  prac- 
tices. The  effects  of  logging  and  road  construction 
on  erosion  and  sediment  yields  are  also  considered. 

The  objective  has  been  to  design  a  model  that:  (1) 
is  formulated  in  terms  of  the  diverse  form,  struc- 
ture, and  arrangement  of  natural  forest  stands;  and 
(2)  at  least  qualitatively  accounts  for  the  response  of 
these  stands  to  management,  based  on  the  best 
information  available. 


Theory 

Comparison  of  Subalpine  Water  Balance  Model 
and  Land  Use  Model 

Leaf  and  Brink  (1973a,b)  have  previously  de- 
scribed a  water  balance  model  for  simulating  runoff 
from  subalpine  watersheds.  This  model  is  now 
being  used  in  representative  areas  throughout  the 
Rocky  Mountain  region  for  simulating  watershed 
management  practices  and  their  resultant  effects  on 
hydrologic  system  behavior. 


The  Land  Use  Model  has  greatly  expanded 
capabilities  in  that  it  utilizes  the  output  from  the 
Subalpine  Water  Balance  Model  (Leaf  and  Brink 
1973b)  to  simulate  both  immediate  and  long-term 
effects  of  forest  and  watershed  management  on  the 
water  resource.  Considerable  flexibility  is  provided 
for  simulating  alternative  silvicultural  systems. 

AH  but  two  of  the  subroutines  in  the  core  of  the 
Subalpine  Water  Balance  Model  are  used  by  the 
Land  Use  Model  without  significant  changes;  they 
are  not  discussed  here,  therefore,  but  are  listed  in 
Appendix  11.  Complete  descriptions  of  the  unre- 
vised  routines  are  also  given  in  Leaf  and  Brink 
(1973a, b).  Two  subroutines,  EVTRAN  and  CAN- 
VAP,  were  extensively  revised  as  discussed  later  in 
this  report.  A  "time-trend  package"  has  been 
developed  which  simulates  the  long-term  changes  in 
the  primary  hydrologic  variables.  These  variables 
are  expressed  in  terms  of  accepted  silvicultural  con- 
cepts as  described  in  this  report. 

In  developing  the  Land  Use  Model,  it  was 
necessary  to  restructure  the  Subalpine  Water  Bal- 
ance Model  to  make  it  the  core  system  of  a  more 
versatile  planning  tool.  The  analytical  framework  of 
the  Water  Balance  Model  is  a  watershed  divided 
into  subunits  defined  by  homogeneous  environ- 
mental characteristics  (slope,  aspect,  elevation,  and 
forest  cover  composition  and  density).  Hydrologic 
responses  are  computed  for  each  subunit,  then 
weighted  according  to  their  respective  areas  and 
combined  to  produce  an  overview  of  hydrologic 
system  behavior  on  a  watershed  basis. 

In  the  Land  Use  Model,  the  emphasis  is  shifted 
from  the  watershed  to  a  "planning  unit"  of  any 
size,  which  has  all  of  the  inherent  characteristics  of 
the  hydrologic  subunits  discussed  above,  but  which 
also  accommodates  the  objectives  of  management. 
The  Land  Use  Model  is  designed  to  simulate  the 
effects  of  combinations  of  timber  harvesting  and 
weather  modification  in  order  to  develop  manage- 
ment strategies  for  planning  intervals.  These  plan- 
ning intervals  can  vary  from  a  few  years  to  the 
rotation  age  of  subalpine  forests  (120  years  and 
longer). 

Management  strategies  may  subdivide  a  given 
planning  unit  into  as  many  as  eight  distinct  areas  or 
"response  units"  of  any  size,  which  may  be  man- 
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aged  independently  at  varying  points  in  time  during 
the  planning  interval.  Provision  is  also  made  so  that 
different  cutting  practices  may  be  imposed  on  the 
response  units,  and  finally,  any  number  of  cuttings 
may  be  made  on  a  given  response  unit  at  specified 
years  during  the  planning  interval. 

Hydrologic  integrity  is  maintained  as  manage- 
ment strategies  are  formulated,  since  all  inter- 
actions between  the  various  response  units  are 
accounted  for  in  both  time  and  space.  Moreover, 
the  overall  hydrologic  effects  resulting  from  each 
management  decision  on  the  planning  unit  are  pro- 
jected to  the  end  of  the  planning  interval  as  though 
that  decision  were  the  final  one  in  the  strategy. 
Thus,  the  singular  effects  of  each  decision  can  be 
evaluated. 

Table  1  compares  the  capabilities  of  the  Sub- 
alpine  Water  Balance  Model  described  by  Leaf  and 
Brink  (1973a,b)  and  the  Land  Use  Model  described 
in  this  report. 

Table  1 . — Comparison  of  Subalpine  Water  Balance 
Model  with  Land  Use  Model 


Procedural  Differences  from  Subalpine  Water  Bal- 
ance Model  (fig.  1) 

Step  1  (and  to  some  extent,  step  3)  corresponds 
to  the  Water  Balance  Model  described  by  Leaf  and 
Brink  (1973b).  Both  models  utilize  the  Water 
Balance  routines  as  their  core. 

Since  climatological  observations  are  rarely  avail- 
able for  the  long  periods  of  time  simulated  by  the 
Land  Use  Model,  step  2  extends  the  data  base  by  a 
randomized  selection  of  water  years  until  the 
planning  interval  is  completed. 

Both  models  contain  peripheral  routines  which 
handle  input/output  and  supply  the  continuous  and 
static  conditions  to  the  core.  It  is  the  peripheral 
routines  which  embody  the  different  objectives  of 
each  model. 

The  Water  Balance  Model  was  designed  to 
simulate  the  effects  of  management  strategies  on  an 
entire  watershed  over  relatively  short  periods  of 
time.  Thus,  computer  memory  was  used  extensively 
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Detailed  flow  chart  descriptions  and  pertinent 
theory  follow. 


Land  Use  Model  Configuration  (Program  LUMOD) 

Program  LUMOD  is  the  controlling  routine  for  a 
series  of  five  relatively  independent  steps  in  the 
Land  Use  Model.  The  Control  Data  Corporation's 
6400  FORTRAN  Extended2  provides  Overlay  capa- 
bilities which  are  ideally  suited  to  the  operation  of 
the  model.  If  such  capabilities  are  not  available, 
however,  the  five  steps  could  be  performed  in  a 
series  of  computer  runs  with  communication  among 
them  through  the  use  of  magnetic  tape  files. 
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Figure  1.— General  flow  of  Land  Use  Model. 
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tor  retaining  simulated  results  until  a  composite 
overview  was  produced.  Little  use  was  made  of 
online  storage.  In  the  Land  Use  Model,  however, 
the  objective  has  been  to  extend  the  capabilities  of 
the  Water  Balance  Model  across  a  much  longer 
time  frame,  with  the  added  ability  of  introducing 
new  management  decisions  at  various  points  during 
the  planning  interval.  Not  only  did  we  want  the 
capacity  to  simulate  each  management  decision 
independently,  but  we  wanted  to  be  able  to  view  the 
interactive  effects  of  a  new  decision  on  ones 
previously  implemented.  Moreover,  an  added  objec- 
tive was  to  simulate  the  effects  of  time,  as 
demonstrated  through  reforestation,  on  each  re- 
sponse unit  at  each  point  in  the  planning  interval. 
It  was  therefore  necessary  to  develop  peripheral 
routines  which  were  concerned  with  only  one 
planning  unit  at  one  time.  Use  ofcomputer  memory 
was  diminished  as  use  of  online  storage  increased  to 
facilitate  retention  of:  (1)  input  data  for  "multiple- 
passes";  and  (2)  voluminous  output  data  which  are 
summarized  for  the  planning  unit,  watershed,  and 
perhaps  for  a  region  comprising  several  watersheds. 

Time  Trends. — With  the  Water  Balance  routines 
collectively  defined  as  the  "core  system"  of  the 
Land  Use  Model,  it  is  useful  to  identify  the  time 
trends  routines  as  "satellite"  to  the  model,  since 
they  are  accessed  only  once  each  water  year  as 
opposed  to  daily  utilization  of  the  "core  system." 
Imposition  of  time  trends  on  the  simulation  also 
required  one  additional  means  of  communication 
(common  block /TIME/)  between  routines. 


Response  Units 

A  planning  unit  of  any  desired  size  is  subdivided 
in  the  management  strategy  into  as  many  as  eight 
distinct  management  areas,  called  "response 
units",  seven  of  which  may  be  subjected  to  timber 
harvesting  practices  during  a  planning  interval.  It 
should  be  emphasized  that  a  response  unit  need  not 
be  made  up  of  a  single  forest  area,  but  represents  a 
percentage  of  the  area  of  the  entire  planning  unit. 
For  example,  consider  a  response  unit  that  is  40 
percent  of  the  planning  unit  and  subjected  to  patch- 
cutting.  Such  a  unit  is  not  considered  as  one  very 
large  forest  opening,  but  rather  as  an  array  of  small 
openings  distributed  over  the  entire  planning  unit 
and  occupying  40  percent  of  its  area.  One  response 
unit  out  of  the  eight  is  retained  in  the  "natural" 
state  to  aid  in  simulating  the  redistribution  of 
precipitation  or  weather  modification.  If  the  entire 


planning  unit  is  managed,  however,  the  area- 
weighting  factor  for  the  "natural"  response  unit  is 
set  to  zero  and  it  no  longer  affects  the  results.  It  is 
retained  in  the  simulation,  regardless  of  its  weight, 
since  the  time  trend  functions  cause  the  managed 
response  unit  to  approach  the  same  state  as  the 
natural  response  unit.  All  of  the  time  functions  are 
defined  for  each  managed  response  unit,  and  are 
totally  independent  of  the  functions  for  other 
response  units. 


Model  Subroutines 

The  routines  discussed  below  are  time  trend 
routines  that  compute  changes  in  evapotranspira- 
tion,  soil  water,  forest  cover  density,  retlectivity, 
interception,  snow  redistribution,  and  erosion  and 
sediment  yield.  Peripheral  routines,  which  are 
meaningful  only  in  implementing  the  hydrologic 
and  silvicultural  concepts  on  a  computer,  are  not 
discussed  in  detail  here,  but  can  be  found  in  the 
FORTRAN  listings  in  Appendix  II.  The  remainder 
of  the  Water  Balance  routines  that  comprise  the 
core  system  of  the  Land  Use  Model  are  also 
described  in  Leaf  and  Brink  (1973b). 


Evapotransph-ation. — Subroutines  EVTRAN  and 
CANVAP,  as  described  by  Leaf  and  Brink  (1973b), 
have  been  extensively  revised  to  account  for  the 
regrowth  of  forest  stands  after  harvest  cutting.  In 
computing  evapotranspiration,  there  is  some  evi- 
dence that  water  use  during  the  growing  season 
proceeds  at  rates  limited  only  by  available  energy 
until  the  soil  water  is  depleted  to  50  percent  of  the 
maximum  "available"  for  transpiration  (field  ca- 
pacity index).  Thereafter,  transpiration  is  decreased 
in  proportion  to  the  amount  of  soil  water  below 
one-half  of  the  field  capacity  index.  In  open  or 
cutover  areas,  it  was  reasoned  that  the  absence  of 
dense  vegetation  and  a  highly  developed  root  system 
reduces  evapotranspiration  below  maximum  rates 
unless  the  soil  mantle  is  completely  recharged. 
Thereafter,  evapotranspiration  is  linearly  decreased 
to  zero  at  three-fourths  of  the  field  capacity  index 
(fig.  2a).  As  forest  vegetation  is  established  on 
cutover  areas  and  consumptive  use  increases,  the 
relationship  in  fig.  2a  changes  until  ultimately,  as 
the  forest  cover  is  reestablished,  it  approaches  the 
old-growth  forest  curve  (fig.  2b).  It  is  this  phenome- 
non which  is  primarily  responsible  for  diminishing 
water  yield  increases  from  timber  harvesting.  The 
rate  at  which  this  transition  takes  place  depends 
upon  forest  species,  climate,  stand  conditions,  and 
the  objectives  of  management. 
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(a) 


Figure  2.  — Relationships  showing  evapotranspiration 
as  a  function  of  available  soil  water  for:  \a)  old- 
growth  forest  and  open  conditions,  and  (b)  old- 
growth  forest  and  some  intermediate  forest  cover 
condition  several  years  after  timber  harvesting. 


A  general  expression  tor  the  relations  shown  in 
figure  2  can  be  written  as  follows: 

0  =  a|/3-  ^-^)J  =  AG8-t)+1 

p  t,  e  =  1 

T"l<j8<T  [1] 
/3<T-^e  =  o 


E 

where  $  —  the  ratio,  =A  Ea  is  the  actual  evapo- 

s 

transpiration  rate  and  Es  is  com- 
puted in  this  model  by  a  modified 
version  of  the  Hamon  equation  (Leaf 
and  Brink  1973b). 

0  =  the  available  soil  water  at  any  time, 
can  vary  between  O  and  M,  where 
M  is  the  "field  capacity  index." 

X  =  the  critical  point  at  which  available 
soil  water  begins  to  limit  evapotrans- 
piration. can  vary  between  M/2 
and  M. 

A  =  the  slope  of  the  relationship  between 
Ea/Es  =  0  and  1. 

In  addition  to  complex  factors  such  as  ecological 
habitat  and  stand  condition,  the  rate  at  which  a 
forest  reestablishes  itself  varies  according  to  species. 
Discussions  and  background  literature  for  the  three 
major  forest  types  of  the  subalpine  zone  are 
summarized  by  Alexander  (1974).  Of  the  three 
types,  spruce-fir  forests  are  the  most  difficult  to 
regenerate,  and  therefore  require  the  longest  time 
for  regrowth.  Due  to  its  seed  production  and  growth 
habits,  lodgepole  pine  does  not  require  as  much 
time  to  reestablish  itself.  Finally,  since  aspen 
normally  regenerates  from  root  suckers,  a  new 
stand  promptly  occupies  the  site,  and  on  many  sites 
growth  exceeds  that  of  associated  conifers  for 
decades. 

Hydrologic  changes  resulting  from  timber  harvest 
in  the  subalpine  zone  persist  for  many  years.  The 
Fool  Creek  watershed  study  in  central  Colorado 
(Hoover  and  Leaf  1967,  Leaf  1975)  resulted  in 
water  yield  increases  which  did  not  show  a 
significant  decline  more  than  15  years  after  treat- 
ment. These  results  and  results  from  timber 
management  research  were  used  to  develop  the 
time-trend  relationships  discussed  below. 

The  procedure  used  in  deriving  the  assumed 
time-trend  equations  was  to:  (1)  establish  plateaus, 
and  maximum  and  minimum  values  for  each 
hydrologic  parameter;  (2)  establish  critical  values  at 
which  a  transition  takes  place  (that  is,  "when  things 
begin  to  happen");  and  (3)  assume  a  functional 
relationship  for  each  process  which  determines  all 
intermediate  values  with  respect  to  time. 

Although  the  time-trend  relationships  may  not  be 
inherently  correct,  they  are  certainly  plausible  in 
light  of  our  present  understanding  of  long-term 
hydrologic  phenomena.  The  validity  of  the  equation 
should  be  determined  by  additional  research. 

Soil  Water. — The  critical  point  at  which  available 
soil  water  begins  to  limit  evapotranspiration  (  t  ) 
was  assumed  to  vary  with  time  and  species  (fig.  3): 
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Figure  3.  — Variation  of  T  with  time  and  vegetation  type. 


T  =  M,  t  <  tc, 

t  =  M/2,  t  >  tr 


[2] 


where  k  =  an  index  of  the  rate  of  decline  of  t. 

t     =  the  time  at  which  available  soil  water 
c  •    •  • 

begins  to  limit  evapotranspiration  in 

years. 

t  =  the  time  at  which  the  hydrologic  effect 
of  timber  harvesting  becomes  insignif- 
cant. 

The  parameters,  k  and  t    ,  vary  according  to 

forest  species.  When  t<  tc  ,  no  adjustments  are 

made  in  the  soil  water  correction,  since  watershed 
experiments  indicate  that  a  correction  is  not 
warranted  for  a  number  of  years  after  timber 
harvest.  Assumed  values  of  tr  ,  tr,  and  k  for  the 
three  species  are: 


Forest  type 

aspen 

lodgepole  pine 
spruce-fir 


7  years  60  years 
15  years  80  years 
30  years  100  years 


0.01 
.01 
.01 


The  assumed  relationship  between  A  and  T  is 
given  by: 


A  = 


4r 
M2 


[3] 


Substituting  equation  [2j  and  [3]  into  equation 
fl]  yields 


0  =  4e-k(,-,c1)   [/S/M-e-^-V]  +1 


[4] 


which  is  a  general  equation  for  6  as  a  function  of 
forest  cover  type,  field  capacity  index,  and  time. 


Forest  Cover  Density. — Forest  cover  density  plays 
an  important  role  in  the  simulation  model.  It  is  the 
major  descriptive  parameter  of  the  form,  structure, 
and  arrangement  of  forest  stands,  and  therefore 
controls  the  energy  balance,  interception,  and 
evapotranspiration.  Forest  cover  density  as  used  in 
the  Land  Use  Model  is  not  defined  as  "canopy"  or 
"crown  closure,"  but  rather  as  a  parameter  that 
describes  the  net  effects  of  the  vegetation  on  the 
transmission  of  solar  radiation  to  the  forest  floor. 
Forest  cover  density  varies  according  to  crown 
closure,  the  vertical  foliage  distribution,  species, 
season,  and  stocking  (Reifsnyder  and  Lull  1965). 
Empirical  relationships  between  various  timber 
stand  variables  and  percent  radiation  beneath  the 
forest  canopy  (transmissivity  coefficient)  have  been 
determined  from  field  measurements  (Miller  1959, 
Muller  1971).  A  similar  relationship  was  derived  for 
the  three  major  subalpine  forest  species  in  the 
process  of  calibrating  the  model  against  observed 
snowmelt  rates  (Leaf  and  Brink  1973a)  and  from 
solar  radiation  transmission  studies  in  central 
Colorado.  The  resulting  equation  from  this  work  is 
given  by 


T  =  0.19  C 


-0.6 
dmx 


t5] 


where  T  =  the  transmissivity  of  the  forest  canopy 
expressed  as  a  decimal  fraction  of  the 
amount  of  solar  radiation  available 
above  the  forest  canopy, 
the  natural  old-growth  forest  cover 
density  (expressed  as  a  decimal). 


dmx 


Combinations  of  Cjjmx  and  T  that  were  found 

acceptable  during  calibration  of  the  model  for 
lodgepole  pine,  aspen,  and  spruce-fir  in  central 
Colorado  are  summarized  below: 


Forest  type 

lodgepole  pine 

spruce-fir 

aspen 
foliated 

defoliated 


dmx 


0.25-0.45 
0.50-0.65 


0.40-0.30 
0.30-0.25 


0.35 
0.20 


0.35 
0.50 
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Figure  4.  —Assumed  variation  of  A  as  a  function  of  r  . 


As  vegetation  reoccupies  cutover  areas,  forest 
cover  density  (C^)  increases  with  time  until  it 

reaches  a  maximum.  Research  has  shown  that  the 
rate  at  which  canopy  development  reaches  this 
plateau  depends  on  environmental  conditions, 
stocking  levels,  and  species.  In  coniferous  forests,  it 
can  vary  from  30  to  more  than  80  years;  in  aspen, 
growth  and  resultant  canopy  development  is  nor- 
mally much  more  rapid  due  to  the  presence  of  an 
extensive  root  system  at  the  time  of  stand  regener- 
ation (Pollard  1972).  Accordingly,  the  following 
assumed  relationship  for       as  a  function  of  time 

was  developed: 

Cd=%L(t-W2  t 


t  <I> 


[6] 


where  C  =  intermediate  forest  cover  density  ex- 
pressed as  a  decimal. 


d 


the  time  in  years  from  t     at  which 

maximum   forest   cover   density  is 
reached.   This  parameter  was  as- 
sumed to  vary  according  to  vegeta- 
tion type  as  follows: 
Forest  type  4> 
lodgepole  pine      40  years 
spruce-fir  80  years 

aspen  20  years  and 

critical  time  at  which  regeneration  is 
sufficient  to,  reestablish  the  stand 

when  t  <  t    ,  C  ,  =  0. 

c,  d 


Reflectivity. — The  relationship  between  reflectiv- 
ity and  forest  cover  density  derived  by  Leaf  and 
Brink  (1973b)  was  modified  as  follows: 


R,  =  R(oexp 


[7] 


R    =  the  reflectivity  of  the  forest  stand. 


 f 

R,  = 
fo 


CO 


the  reflectivity  of  a  forest  opening  (as- 
sumed herein  as  0.5).  When  t  <  t£  , 

R    =  0.5. 

1.609  C 

dmx 


Subroutine  EVTRAN  as  used  in  the  Land  Use 
Model  incorporates  the  effects  of  natural  regenera- 
tion discussed  above.  As  explained  in  the  discussion 
for  Subroutine  TRENDS,  the  final  computations  of 
the  adjustment  factor  for  available  soil  water 
(equation  4)  are  performed  in  Subroutine  EV- 
TRAN, since  they  are  dependent  on  the  dynamic 
state  of  the  soil  mantle  storage.  The  simulated 
potential  evapotranspiration  Es  is  then  adjusted  for 

both  available  soil  water  and  canopy  reflectivity 
(equation  7)  to  produce  the  actual  evapotranspira- 
tion Ea>  It  should  be  noted  that  equation  7  is  con- 
stant over  a  water  year  and  is  recomputed  after 
each  growing  season.  Subroutine  EVTRAN  also 
alters  the  soil  mantle  storage  according  to  the 
calculated  evapotranspiration. 


G 


EVTRAN 


REDEFINE  ET 
AND  STORAGE 
TO  STOP  AT 
WILTING  POINT 


INCLUDE  REGROWTH 

IN  COMPUTING 
AVAILABLE  SOIL 
WATER  ADJUSTMENT 

ADJUST  ET  FOR 
AVAILABLE  SOIL 
WATER  AND 
REFLECTIVITY 

•(  RETURN  y* 


Figure  5.— Subroutine  EVTRAN. 
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Interception. — Subroutine  CANVAP  (Leaf  and 
Brink  1973b)  is  essentially  unchanged  except  that 
allowance  is  made  for  snow  interception  as  the 
forest  regrows  after  harvest  cutting,  by  weighting 
the  effects  of  both  snow  evaporation  from  areas  not 
occupied  by  trees  (SNOWVAP  in  Leaf  and  Brink 
1973b)  and  evaporation  from  intercepted  snow.  In 
the  Land  Use  Model,  evaporation  from  the  snow 
surface  and  from  intercepted  snow  is  computed  by 
the  following  rational  relationships: 

Vs  =  (1  -  Cd)Es  and  [8] 

Vc  =  (1/Cd)Es  [9] 

where  Vs  =  evaporation  from  the  snow  surface. 

Vc  =  intercepted  snow  evaporation. 

=  intermediate  forest  cover  density  ex- 
pressed as  a  decimal,  where  Cj  < 
r 

dmx " 

Es  =  potential  evapotranspiration  as  de- 


fined in  equation  [1]. 


When  C>^ 

d-  2 


dmx 


and  snow  rests  on  the  canopy, 


evaporation  is  computed  by  equation  [9];  when  the 
canopy  is  free  of  snow,  evaporation  takes  place 
according  to  equation  [8].  However,  when  0<  C  ,< 
C 

^mx ,  both  equations  [8]  and  [9]  are  used  as 
2 

follows: 


V,=  ES 


[10] 


V  =  combined  evaporation  from  snow 
surface  and  intercepted  snow  in  cut- 
over  areas. 

We  believe  that  equation  [10]  more  realistically  rep- 
resents the  evaporation  from  cutover  areas  that  are 
not  completely  occupied  by  forest  vegetation.  When 


CJ  =  0, 
d 


V  = 
t 


V  .  By  substituting  equation  [6] 


into  equation  [10],  the  following  relationship  is 
obtained: 


V,=  E! 


(- 


4>2 
Cdmx 

*2 


{t-tc} 


•)] 


[11] 


which  expresses  V{  as  a  function  of  C(jmx  and 
time. 


Snow  Redistribution. — Redistribution  of  snow  as 
a  result  of  patch-cutting  is  a  significant  factor 


influencing  runoff.  In  lodgepole  pine,  this  phe- 
nomenon is  not  diminished  more  than  30  years  after 
timber  harvest  in  spite  of  regrowth  of  trees  and 
increased  forest  cover  density  (Hoover  and  Leaf 
1967).  Changes  in  natural  snow  accumulation 
patterns  produced  by  patch-cutting  will  likely 
persist  until  the  new  crop  of  trees  approaches  the 
height  of  the  surrounding  forest.  Accordingly,  the 
following  relationships  were  developed  for  simulat- 
ing snow  redistribution  effects  with  time  and  forest 
species: 

p  =  pmxexp  [-ki(t-  t^)]  [12] 

t=£tri,p=  1 

where  P  =  snow  redistribution  factor  in  the  cut- 
over  area,  which  varies  according  to 
the  silvicultural  system  used.  For  ex- 
ample, when  40  percent  of  the  area  is 
occupied  by  small  openings  5  tree- 
heights  in  diameter,  the  winter  snow- 
pack  is  increased  by  30  percent  in  the 
open  and  decreased  20  percent  in  the 
uncut  forest. 
p„,v  —  the  redistribution  factor  immediately 
after  timber  harvesting, 
an  index  of  the  rate  of  decline  of  p. 


mx 
k 


t  =  the  time  at  which  forest  regrowth 
begins  to  reduce  snow  redistribution  in 
years. 

t    —  the  time  at  which   forest  regrowth 
'       causes  snow  redistribution  to  become 
insignificant. 

The  parameters  k,  t    ,  and  t     vary  according  to 

r,  c, 

forest  species.  When  t  <  t    ,  no  adjustments  are 

made  in  the  redistribution,  since  field  studies 
indicate  that  a  correction  is  not  warranted  for 
several  years  after  harvest  cutting.  Assumed  values 

oft    ,  t    ,  and  k,  for  the  three  subalpine  types  are 

c3  r, 

summarized  below: 


Forest  type 

aspen 

lodgepole  pine 
spruce-fir 


c3 


20  years  80  years 
40  years  1 20  years 
80  years   160  years 


0.57 
.04 
.04 


It  should  be  emphasized  that  redistribution  is 
optimum  only  when  timber  is  harvested  in  small 
patches  (5-8  tree  heights  in  diameter)  that  occupy 
less  than  50  percent  of  a  given  planning  unit.  For 
other  combinations  of  opening  size  and  area,  the 


7 


redistribution  factor  should  be  reduced  in  propor- 
tion to  the  size  of  openings  above  and  below  5  to  8 
tree  heights. 


Individual-tree  Selection  Cutting. — In  the  Land 

Use  Model,  selection  cutting  corresponds  to  a 
reduction  of  the  forest  cover  density  (C^).  The 

degree  that  is  reduced  depends  on  the  character- 
istics of  the  stand  and  the  volume  of  timber 
removed.  If       is  reduced  by  50  percent  or  less 

from  Cj      ,  it  is  assumed  that  forest  canopy  density 

does  not  increase  subsequent  to  cutting.  However,  if 
is  reduced  more  than  50  percent  from  C^mx, 

equation  [6]  is  used  to  simulate  redevelopment  of 
the  canopy  with  time.  Solving  equation  [6]  for  time 
yields: 


t, 


\  ^dmx  / 


+  t 


c2 


[13] 


If  the  degree  to  which  thinning  reduces  C  ,  is 
&  &  dmx 

given  by  77,  then      is  given  by 

C.  -  C.     (1  -  if) 
d  dmx 

Hence,  equation  [13]  can  be  written  as: 
t,  =  4)  [(1  -  ^)]  %  +  tC2  [14] 
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USE 
APPROPRIATE 
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CALCULATE  AS 
A  FUNCTION  OF 


NO  REDISTRIBUTION 

REDEFINE  THE 
"NATURAL"  REDIST. 
FACTOR 


Figure  6. —Subroutine  TRENDS. 


t  =  the  time  required  to  reach  the  reduced 
forest  cover  density  as  if  the  stand  were 
initially  patch-cut. 

V  —  the  degree  that      is  reduced  from  C^mx 

(expressed  as  a  decimal). 

All  of  the  time  trend  relationships  are  then  initial- 
ized at  t,j  to  simulate  the  hydrologic  effects  of 

selection  cutting. 

Subroutine  TRENDS  (Fig.  6).— This  routine 
initially  defines  the  time  functions  discussed  above 
in  terms  of  the  boundary  conditions  supplied  by 
Subroutine  GBROUND.  After  each  growing  sea- 
son, Subroutine  TRENDS  redefines  the  functions 
whenever  necessary  to  incorporate  the  effects  of 
time. 


Subroutine  GBOUND  (Fig.  7).— Subroutine 
GBOUND  is  used  to  initialize  the  basic  functions 
which  comprise  the  time  trends  concept.  These 
functions  are  expressed  in  terms  of  a  wide  variety 


of  management  practices.  As  trees  regrow  after 
cutting,  the  impact  of  the  original  removal  is 
diminished  until  the  hydrologic  changes  are  no 
longer  significant.  Therefore,  all  parameters  are 
specified  in  terms  of  the  number  of  years  following 
treatment  (t    )  when  the  effect  of  timber  harvesting 

begins  to  diminish,  and  in  terms  of  the  number  of 
years  following  treatment  when  hydrologic  changes 
become  negligible.  If  the  parameters  are  not 
specified,  the  model  assumes  the  values  indicated  in 
table  2,  which  vary  according  to  vegetation  type. 

Subroutine  GBOUND  converts  the  boundary 
years  into  "real  time"  based  on  the  year  of 
treatment,  and  calculates  the  required  parameters 
that  are  dependent  solely  on  the  boundary  condi- 
tions. 


Erosion  and  Sediment  Yield 

One  of  the  environmental  impacts  associated  with 
land  use  in  the  subalpine  zone  is  erosion  resulting 
from  road  construction.  Accordingly,  indices  of 
onsite  erosion  and  sediment  yield  downstream  are 
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Figure  7.— Subroutine  GBOUND. 


computed  by  the  Land  Use  Model.  The  erosion 
indices  are  computed  from  a  system  of  empirical 
equations  developed  by  Leaf  (1974),  based  on  field 
measurements  of  sediment  yields  in  central  Colo- 
rado (Leaf  1966,  1970,  1971),  and  a  time  trend 
equation  proposed  by  Megahan  (1974). 

The  model  is  based  on  measurements  of  accumu- 
lated sediment  below  a  1 -square-mile  experimental 
watershed.  The  sediment  contained  enough  leaf 
litter  and  related  organic  debris  so  that  the  dry 
volumes  of  mineral  soil  occupied  approximately  75 
percent  of  the  total  volume  of  debris  (dry  unit 
weight  approximately  85  lb/ft').  Moreover,  the  data 
were  obtained  from  a  stable  watershed  (26  percent 
average  slope)  and  a  road  system  that  was 
carefully  constructed  with  a  high  standard  of 
followup  maintenance.  Thus,  although  the  equa- 
tions may  not  be  generally  applicable  throughout 
the  Rocky  Mountain  Region,  we  believe  they  will 
serve  as  good  first  approximations  of  total  sediment 
yield  until  more  data  become  available. 


Table  2, — Assumed  boundary  years  for  the 
time  trend  functions 


Factor 


Years  before     Years  until 
effect  begins  effect  becomes 
to  diminish  negligible 


Lodgepole  pine 

Available  soil  water  15 
Canopy  reflectivity  0 

Precipitation 

redistribution  40 

Spruce-fir 

Available  soil  water  30 

Canopy  reflectivity  0 

Precipitation 
redistribution  80 

Aspen 

Available  soil  water 

Canopy  reflectivity  0 

Precipitation 

redistribution  20 


80 
40 

120 

100 
80 

160 

60 
20 

80 


Sediment  yields  are  expressed  in  terms  of  water- 
shed characteristics,  engineering  design  variables, 
and  time.  The  equation  for  predicting  cumulative 
onsite  erosion  is: 


S  =  0.12  DEn 


[15] 


D  = 


where  S  =  the  total  cumulative  onsite  erosion  at 
time  (t)  after  disturbance  in  ft3, 
the  projected  length  of  the  disturbed 
area  perpendicular  to  the  road  center- 
line  in  ft. 

the  unit  cumulative  onsite  erosion  at 

time  (t)  after  disturbance  in  ft '/acre. 

the  number  of  miles  of  road  system. 

5,280  Ji  -v-  43,560 
nu, 


E  = 


n 

0.12 


ft2 


acre 


The  projected  length  (D)  is  given  by  the  equation 
W/2  tan  v 


D  =  W 


tan  O  -  tan  v 


[16] 


where  W  =  the  "effective"  width  of  road  in  ft. 

v  =  steepness  of  the  watershed  sidelope  in 
degrees. 

0  =  0c  =  0f  =  the  average  angle  of  the  cut 
and  fill  slopes  in  degrees. 
The  unit  cumulative  erosion  (E)  describes  the 
erosion  time  trend,  and  can  be  expressed  as 


E  =  e„t  -  S0  (e 


-k,t 


D 


[17] 
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where  en  =  an  estimate  of  the  long-term  "nor- 
mal" erosion  rate  on  the  undisturbed 
area  in  ftVacre.  For  central  Colo- 
rado, (en)  is  equal  to  0.28  ftVacre 

based  on  15  years  of  data  collected 
from  undisturbed  watersheds. 

S0  =  an  index  of  the  amount  of  soil  avail- 
able for  erosion.  This  index  is  201.3, 
based  on  statistical  fitting  to  field 
measurements. 

k2  =  an  index  of  the  rate  of  decline  of  ero- 
sion following  disturbance,  defined  to 
be  0.085  by  statistical  fitting  meth- 
ods. 

Sediment  yields  downstream  expressed  on  a 
watershed  basis  are  given  by  the  equation 

Qs=f  [18] 

Equation  [lb]  assumes  balanced  cut  and  fill  (i.e., 
that  the  centerline  bisects  the  road  width).  This  is 
not  usually  the  case,  since  the  cross-section  can  vary 
from  total  cut  to  total  fill  in  actual  practice. 
However,  we  believe  that  a  sufficiently  accurate 
index  of  the  total  area  disturbed  can  be  obtained  by 
estimating  an  "effective"  width  and  average  cut  and 
fill  slopes  for  the  proposed  road  system.  Such 
estimates  require  considerable  judgment  and  a 
knowledge  of  the  topography. 

Three  additional  assumptions  are  behind  equa- 
tions [15]  -  [17].  First,  it  was  assumed  that  the 
equations  provide  a  better  index  of  erosion  than 
equations  based  on  rainfall-derived  erodibility  in- 
dices. Such  equations  may  be  grossly  in  error,  since 
they  do  not  predict  time  trends,  nor  do  they  account 
for  the  effects  of  melting  snow,  which  is  responsible 
for  much  of  the  sediment  yield  from  the  subalpine 
zone  in  central  Colorado.  The  second  assumption 
was  that  onsite  erosion  is  proportional  to  the  area 
disturbed.  Finally,  it  was  assumed  that  the  delivery 
ratio  is  constant  for  a  given  watershed  size,  regard- 
less of  the  amount  of  area  disturbed.  These 
assumptions  involve  complex  interactions  between 
the  hydrology,  geology,  and  soil,  which  need  to  be 
verified  by  additional  study. 

Equation  [18]  is  valid  provided  that  the  upstream 
drainage  area  does  not  exceed  1  square  mile. 
Sediment  yields  at  downstream  points  would  be 
less,  since  delivery  ratios  are  inversely  related  to 
watershed  area.  It  should  be  noted  that  the  model 
has  not  been  programmed  to  compute  delivery 
ratios  for  upstream  areas  greater  than  1  square 
mile. 

Because  equations  [15]  -  [18]  describe  sediment 
yields  in  terms  of  watershed  slope  and  engineering 
design  parameters,  the  land  use  planner  has  at  least 
some  latitude,  subject  to  the  limitations  discussed 


above,  in  evaluating  the  potential  short-  and  long- 
term  impacts  of  alternative  road  systems  required 
for  various  timber  harvesting  practices. 

Subroutine  SEDMOD  (Fig.  8).— Equations  [15]  - 
[18]  are  appended  to  the  Land  Use  Model  as  Sub- 
routine SEDMOD.  Program  LUMOD  provides  the 
road  design  and  sediment  model  parameters. 

Applications 

We  have  used  the  Land  Use  Model  to  simulate 
the  long-term  effects  of  forest  and  watershed 
management  on  the  South  Tongue  River  in  the 
Bighorn  National  Forest  (fig.  9).  Elevations  on  the 
timbered  portions  of  this  drainage  basin  vary  from 
approximately  8,000  to  8,900  ft.  msl.  Soils  are 
derived  from  granitic  rocks;  virtually  all  of  the 
forest  cover  is  lodgepole  pine.  To  illustrate  how  the 
model  has  been  used,  results  from  the  analysis  of 
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Figure  8.— Subroutine  SEDMOD. 
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Figure  9.  — Location  map  for  South  Tongue  River,  Bighorn  National  Forest. 
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one  planning  unit  will  be  summarized  here.  Aver- 
age values  for  pertinent  geographic  and  hydrologic 
characteristics  of  a  typical  forested  watershed  in  the 
South  Tongue  River  drainage  basin  are:5  area,  640 
acres;  elevation,  8,480  ft.;  aspect,  WSW;  slope, 
17%;  C^^^,  40%;  peak  snowpack  water  equiva- 
lent, 15.5  in.;  annual  precipitation,  29.6  in.; 
evapotranspiration,  15.8  in.;  annual  runoff,  13.8 
in. 

In  addition  to  improving  water  yield,  the  man- 
agement strategy  selected  for  this  example  is 
compatible  with  wildlife  habitat  improvement  and 
timber  production.  Under  this  strategy,  the  old- 
growth  timber  would  be  harvested  so  that  approxi- 
mately 40  percent  of  the  planning  unit  area  would 
be  occupied  by  small  openings  —  five  to  eight  times 
tree  height.  Forest  openings  would  be  constructed 
in  a  balanced  and  unified  pattern  that  is  visually 
compatible  with  the  natural  landscape.  The  open- 
ings would  be  permanently  maintained  by  clearing 
the  natural  reproduction  at  30-year  intervals  after 
the  initial  patch-cut. 

The  remaining  60  percent  of  the  planning  unit 
area  would  be  retained  in  continuous  forest  cover. 
However,  trees  would  also  be  removed  from  this 
area  on  an  individual  tree  basis  at  30-year  intervals 

3Based  on  hydrologic  simulation  analyses  of  the 
effects  of  timber  harvesting  on  Prune  Creek,  a 
2, 461 -acre  tributary  of  the  South  Tongue  River  (see 
fig-  9.). 


Table  3. — Projected  changes  in  water  yield  resulting 
from  timber  harvesting,  South  Tongue  River 
Planning  Unit,  Bighorn  National  Forest 


Interval         Water  yield  increase,  by  treatment 
(Years)  I  II         III  IV 


Inches 


0-10 

+  1.58 

11-20 

+  1.87 

21-30 

+  1 

.15 

31-40 

+ 

.85 

+  1.59 

41-50 

+ 

.71 

+  1.78 

51-60 

+ 

.60 

+  1.54 

61-70 

+ 

.38 

+  2.97 

71-80 

+ 

.10 

+  2.41 

81-90 

+ 

.04 

+  1.93 

91-100 

.05 

101-110 

.02 

111-120 

.01 

so  that  the  old-growth  is  gradually  converted  into  a 
broad-aged  stand. 

The  simulated  management  strategy  essentially 
follows  the  recommendations  published  by  Alex- 
ander (1972),  which  are  keyed  to  stand  descrip- 
tions, insect  and  disease  problems,  and  windfall 
risk  situations. 

The  management  strategy  would  maintain  a 
vigorous  and  productive  forest  cover  throughout  the 
planning  interval. 

Runoff  Increases 

The  diagram  below  illustrates  the  management 
strategy  selected  for  this  example: 


Response  unit 
Management  (percent  of  planning  unit  area) 

strategy  1(40%)    2(30%)  3(30%) 


Patch  1st  yr.1  X 

Select  31st  yr. 2  X 

Clear3  X 

Select  61st  yr. 2  X  X 

Clear3  X 

Clear  91st  yr. 3  X 

Select2  X 


{Forty  percent  of  planning  unit  area  occupied  by 
openings  5  to  8  tree-heights  in  diameter. 
2 Individual-tree  selection  cut  so  that  forest  cover 
density  (C^)  is  reduced  50  percent. 
Clear  regrowth  from  permanent  openings. 

Projected  10-year  mean  runoff  increases  under 
this  management  strategy  are  summarized  in  table 
3.  The  increases  above  the  heavy  diagonal  line  at 
any  given  time  represent  the  overall  response  result- 
ing from  preceding  management  decisions.  The 
data  below  the  line  reflect  the  singular  effects  of  the 
initial  patch-cut  on  40  percent  of  the  planning  unit, 
as  if  it  were  the  final  decision  in  the  strategy. 

Water  yields  are  improved  throughout  the  plan- 
ning interval,  with  the  highest  increases  occuring 
after  Treatment  III.  The  projected  runoff  increases 
during  each  treatment  interval  are: 

Treatment  Runoff  increase 

Percent 
1  11.1 


+  2.92  II  11.9 

+  2.75  III  17.7 

+  1.79  IV  18.0 
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Apparently,  the  effect  of  the  intial  patch-cut 
persists  for  at  least  60  and  perhaps  70  years.  There- 
after, the  effect  on  water  yield  becomes  negligible 
for  all  practical  purposes. 


Seasonal  Distribution  of  Water  Yields 

The  projected  effects  of  the  management  strategy 
on  distribution  of  water  available  for  streamflow  are 
summarized  in  table  4.  These  values  represent 
increments  of  generated  runoff,  not  routed  stream- 
flow.  Hence,  the  effects  of  watershed  storage  must 
be  considered  in  interpreting  the  data. 

As  seen  in  table  4,  inputs  from  snowmelt  are 
significantly  increased  during  the  April  16-30  and 
May  1-15  intervals,  and  decreased  in  June.  Minor 
inputs  to  streamflow  also  occur  in  July,  as  com- 
pared to  no  input  in  the  natural  state,  due  to  the 
less  favorable  hydrologic  condition  of  the  water- 
shed. 


Peak  Flows 

The  hydrologic  analysis  in  this  example  indicates 
that  peak  flows  will  be  changed  little  if  at  all  under 
the  proposed  management  strategy.  However,  sea- 
sonal peaks  would  occur  approximately  9  days 
earlier: 


Treatment 


I 

II 
III 

IV 


Change  in  peak 
7 -day  generated 
runoff 

Inches 


-0.2 
0 

+  .3 
+  .4 


Change  in 
timing 

Days 


-9 
-9 
-9 
-10 


The  projected  overall  effect  of  the  proposed 
management  strategy  on  runoff  timing  and  peak 
flows  would  be  to  increase  snowmelt  and  resultant 
streamflow  in  April  and  May.  This  accelerated 
input  would  enlarge  early  spring  flows  and  cause 
the  hydrograph  to  peak  approximately  1  week 
earlier  throughout  the  planning  interval.  Annual 
peak  flows  would  not  be  increased,  however,  and 
runoff  on  the  recession  side  of  the  hydrograph 
during  the  summer  months  may  be  slightly  dimin- 
ished. 


Erosion  and  Sediment  Yield 

It  is  assumed  that  the  proposed  logging  operation 
on  the  planning  unit  would  require  the  equivalent 
of  approximately  12  miles  of  road  system,  including 
all  spur  roads  and  landings.  Because  most  of  the 
disturbed  area  would  be  occupied  by  roads,  it  can 
be  described  in  terms  of  road  design  variables, 
which  have  the  following  characteristics  based  on 
watershed  side  slopes  averaging  17  percent: 


"effective  width" 
average  cut  and  fill  slopes 
width  of  disturbed  area 

area  disturbed  per  mile 


14  feet 
l'/2:l 

1 9  feet  (from 
equation  [16]) 
2.3  acres 


The  total  area  disturbed  on  the  1 -square-mile 
planning  unit  is  approximately  28  acres.  For  the 
purposes  of  this  example,  it  is  assumed  that  the 
entire  road  system  would  be  constructed  before 
logging  operations  on  the  planning  unit.  Thus  most 
of  the  impact  from  road  construction  would  take 
place  during  the  first  30-year  treatment  interval. 

The  projected  10-year  mean  erosion  increases 
produced  by  the  proposed  road  system  are  summar- 
ized in  table  5.  Erosion  on  the  28  acres  disturbed 
would  increase  631  ft3  above  the  untreated  norm  of 
3.8  ft3  immediately  after  the  road  construction, 
then  decrease  to  less  than  1  ft3  above  the  norm  after 


Table  4. — Projected  changes  in  distribution  of  water  available  for  streamflow  resulting  from 
timber  harvesting.  South  Tongue  River  Planning  Unit,  Bighorn  National  Forest 


Natural 

Runoff                    generated  Average  change  in  generated  runoff,  by  treatment 

interval  runoff  I  II  III  IV 


Indies 

April  16-30 

0.1 

+0.9 

+0.7 

+  1.2 

+  0.5 

May  1-15 

1.7 

+  2.1 

+  2.5 

+  2.2 

+  3.1 

May  16-31 

5.9 

+  .6 

+  .3 

+  .5 

+  1.3 

June  1-15 

5.6 

-3.0 

-2.7 

-2.5 

-3.1 

June  16-30 

.7 

-  .4 

-  .3 

-  .5 

-  .5 

July  1-15 

0 

+  .1 

+  .1 

+  .1 

+  .1 
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90  years.  It  is  expected  that  after  the  first  30  years, 
increased  erosion  would  be  one-fifth  of  that  immed- 
iately after  road  construction.  By  60  years,  it  would 
be  one-seventieth.  Ratios  of  increased  erosion  on 
the  disturbed  area  to  the  norm  before  road 
construction  for  each  30-year  treatment  interval  are 
tabulated  below. 

Treatment   Ratio  

(Increase/undisturbed  norm) 

I  43.4 

II  3.4 

III  .3 

IV  .1 

Although  a  40-fold  increase  in  on-site  erosion 
appears  high  at  first,  it  must  be  weighed  against  the 
typically  minimal  erosion  on  subalpine  watersheds. 
Whether  or  not  the  increased  erosion  and  sediment 
yield  are  excessive  would  depend  on  local  require- 
ments for  water  quality  and  fisheries.  On  Fool 
Creek,  in  central  Colorado,  no  detrimental  effects 
on  the  land  resource  or  water  quality  were  observed 
in  spite  of  the  fact  that  on-site  erosion  was 
increased  by  approximately  a  factor  of  60  immed- 
iately after  road  construction.  This  empirical  model 
is  based  on  data  obtained  from  a  carefully  con- 
structed road  system  and  a  high  standard  of 
followup  maintenance,  however.  Any  application  of 
the  model  in  its  present  form  should  presume 
similar  standards  of  construction  and  maintenance. 


Conclusion 

Validation  of  the  Subalpine  Land  Use  Model  will 
require  additional  data  on  long-term  responses.  In 
the  meantime,  we  believe  that  the  output  from  the 
model  will  produce  the  type  of  information  land  use 


Table  5. — Projected  increases'  in  on-site  erosion 
resulting  from  road  construction.  South  Tongue 
River  Planning  Unit,  Bighorn  National  Forest 


Interval  Average  erosion  increase,2  by  treatment 
(years)  I  II  III  IV 


1-10 

631 

Cubic  feet 

11-20 

270 

21-30 

115 

31-40 

49 

41-50 

51-60 

9 

61-70 

4 

71-80 

2 

81-90 

1 

91-100 

<1 

101-110 

111-120 

'Assumptions: 

1.  Area  disturbed  by  road  system  =  28  acres. 

2.  Approximate  unit  weight  of  sediment  —  85 
lb/ ft.3. 

2 Untreated  norm  =  3.8  ft1. 

planners  need  in  order  to  make  difficult  manage- 
ment decisions.  The  ability  of  the  Subalpine  Land 
Use  Model  and  other  similar  models  to  integrate 
complex  forest  and  water  systems  makes  them 
unique  and  powerful  tools  for  evaluating  the  hydro- 
logic  effects  of  a  broad  array  of  land-use  schemes  in 
the  subalpine  zone.  A  user's  guide  for  the  model 
follows  in  Appendix  I.  A  complete  listing  of  the 
model  is  summarized  in  Appendix  II. 
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APPENDIX  I:  USER'S  GUIDE  FOR 
SUBALPINE  LAND  USE  MODEL 


INTRODUCTION 


This  brief  user's  guide  describes  the  input  parameters  necessary  for  the  operation  of  the  Subalpine  Land  Use  Model  (LUMOD) . 
The  parameter  cards  are  discussed  in  the  same  order  as  that  of  the  parameter  card  deck;  thus,  by  preparing  the  cards  in  this 
step-by-step  method,  the  deck  will  be  in  the  proper  order.    The  guide  provides  the  card  columns  in  which  the  parameter  value 
is  to  be  punched,  as  well  as  the  format  by  which  it  is  read.    This  guide  is  intended  for  use  by  those  primarily  concerned  with 
application  of  the  model;  it  does  not  provide  any  computer  systems  information  and,  therefore,  is  of  limited  value  to 
programers  or  others  who  are  computer-oriented. 


The  general  flow  of  the  model  is  as  follows: 


Step  1.    Proofread  the  parameter  card  deck. 


Step  2.     Simulate  the  natural  conditions  from  the  climatological  data  (original  data  base.) 

Step  3.     Extend  the  original  data  base  by  randomly  selecting  years  until  the  desired  planning  interval  is  reached. 


Step  4.     Simulate  the  management  strategy  from  the  extended  data  base. 

Step  5.     Repeat  steps  2-4  for  all  planning  units. 

Step  6.    Combine  the  planning  units  into  a  regional  summary. 


The  following  optional  recovery  procedures  are  provided: 

1.    The  extended  data  base  may  be  saved  on  a  magnetic  tape  named  "SAVNEU." 


2.    The  results  of  the  management  strategy  which  are  used  in  the  regional  summary  are  punched  on  cards  in  the  event  of 
abnormal  termination.    Thus,  if  one  planning  unit  simulation  had  been  successfully  completed  and  the  job  aborted 
during  the  next  planning  unit,  the  RECOVERY  DECK  could  replace  the  planning  unit  deck  for  the  completed  unit  on  the 
next  run.    This  avoids  recomputing  an  entire  planning  unit,  but  still  provides  results  for  use  in  the  regional 
summary . 


REGION  CARDS 

REGIONAL  PARAMETERS 

Card  Columns  Contents  Format 

1  Identified  by  the  word  REGION.  1-6  "REGION"  A6 


The  number  of  years  to  be  simulated  is  generally  11-15 
the  rotation  cycle  for  a  species;  the  original  data 
base  will  be  extended  to  the  specified  number  by 
randomly  selecting  and  repeating  original  years. 

Initialize  the  random  number  generator  with  a  16-20 
positive  number. 

If  a  magnetic  tape  is  provided  under  the  name  21-25 
SAVNEW,  the  extended  data  base  is  captured  and 
saved  for  either  recovery  purposes  or  for  use  with 
other  management  strategies. 


Number  of  years  (1  <  n<  165)  15 

Seed  for  random  number  generator  15 

Save  the  extended  data  base?  (0  =  NO,  1  =  YES,  15 

2  =  copy  SAVOLD  to  SAVNEW  before  adding 
new  files) 


As  the  management  strategy  for  a  planning  unit  is 
completed,  the  information  for  the  composite 
regional  output  is  stored  on  the  recovery  deck  in 
case  the  run  terminates  abnormally.  Under  normal 
termination,  the  recovery  deck  is  not  punched,  but 
if  specified,  it  may  be  punched  regardless  of  the 
mode  of  termination. 


26-30  Punch  the  recovery  deck  even  under  normal  15 

termination?     (0  =  NO,  1  =  YES) 


The  five  principal  hydrologic  components  may  be                31  Print  generated  runoff?     (0  =  NO,  1  =  YES)  II 

independently  selected  for  regional  summary  output.          32                  "  precipitation?  "  "  " 

33  "  evapotranspiration?  "  "  " 

34  "  change  in  storage?  "  "  " 

35  "  change  in  W.  E.?  "  "  " 


The  region  ID  may  contain  80  characters  of  1-80  Region  identification  8A10 

information. 
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PLANNING  UNIT  DECK 

PLANNING  UNIT  ID 
Card 

3  The  planning  unit  ID  may  contain  60  characters  of 

descriptive  information. 


Columns  Contents 

1-60  Planning  unit  identification 


Format 
6A10 


A  two-digit  number  may  be  included  to  identify  the  61-62 
recovery  files.     (It  is  always  appended  to  the  year 
as  a  decimal  on  the  files.) 

If  the  driving  variable  data  are  on  magnetic  tape  64-65 
SAVOLD  (saved  on  a  previous  run),  specify  14. 
Otherwise,  specify  10.     (Note:     if  a  tape  of  card 
images  is  used  rather  than  a  DATA  DECK,  the  tape  ID 
must  be  UNEDIT) .    With  a  14,  the  remaining  cards  for 
NATURAL  CONDITIONS  must  be  omitted,  since  only  the 
management  strategy  simulation  is  to  be  done. 

Indicate  the  percent  of  the  total  region  area  66-68 
represented  by  this  planning  unit.     (.15  =  15%) 


Optional  identification  number  12 


Input  file  (10  or  14)  12 


Area  Weight  F3.2 


If  results  are  wanted  at  the  planning  unit  level,  69 
specify  the  types  of  output.  The  codes  are  as  70 
follows  (note  1.2&3  are  available  only  as  indicated):  71 

72 

0  -  Not  wanted  73 

1  -  Print  the  results  74 

2  -  Print  and  plot  only  the  differences  75 

attributable  to  the  management  76 
strategy  77 

3  -  Both  1  and  2.  78 

79 
80 


Print  detailed  natural  conditions?  (0,1) 

"  list  of  years  in  extended  data  base?  (0,1) 

"  detailed  managed  conditions?  (0,1) 

"  list  of  time  variant  conditions?  (0,1) 

"  generated  runoff?  (0,1,2,3) 

"  precipitation?  " 

"  evapotranspiration?  " 

"  change  in  storage?  " 

"  change  in  W.  E.  " 

"  Bimonthly  generated  runoff?  (0,2) 

"  Peak  W.  E.  and  date?  (0,2) 

"  7-day  peak  R.O.  and  starting  date?  (0,2) 


II 


NATURAL  CONDITIONS 


4  Identified  by  the  words:     SUBSTATION  CONSTANTS  1-20  "SUBSTATION  CONSTANTS"  2A10 

Transmissivity  Coefficient:     (If  left  blank,  the  21-25  Transmissivity  Coefficient  F5.2 

model  will  supply  a  value  as  a  function  of  the 
forest  canopy  density.) 

Estimate  the  decimal  percent  of  the  solar  radiation 
reaching  the  canopy  which  is  transmitted  (allowed  to 
pass  through)  to  the  snowpack  and/or  understory. 
The  following  table  summarizes  combinations  of  cover 
densities  and  transmissivity  coefficients  which  were 
found  acceptable  during  the  calibration  of  the  model 
in  lodgepole  pine  and  spruce-fir  forest  in  central 
Colorado: 


COVER  DENSITY  TRANSMISSIVITY  COEFF 


0.00  (open)  1.00 

.25  .45 

.30,  .35  .40 

.40  .35 

.45  .30 

.55,  .65  .25 


Cover  Density:    Using  the  above  table  as  a  guide,  26-30 
estimate  the  forest  canopy  density  as  a  decimal 
percent.     (In  the  table,  the  values  below  50  were 
for  lodgepole  pine,  with  those  above  50  for 
spruce-fir. ) 

Maximum  Cover  Density:    Normally,  this  value  is  31-35 
the  same  as  number  5.     But  if  a  reduction  in  cover 
density  is  desired,  this  variable  will  allow 
adjustments  to  be  made  in  the  evapotranspiration 
and  energy  balance  to  compensate  for  that  reduction. 

Vegetation  Type  -  Indicate  the  forest  canopy  40 

composition  as  lodgepole  pine,  spruce-fir,  or 

deciduous. 


Cover  Density  F5.2 


Maximum  Cover  Density  F5.2 


1  ■  lodgepole,  2  ™  spruce-fir,  3  =  deciduous  II 


Reflectivity  Threshold  Temperature:    The  model  41-45  Reflectivity  Threshold  F5.0 

assumes  that  fresh  snowfall  increases  the  snowpack 

reflectivity  according  to  internally  controlled 

functions.     However,  field  experience  has  shown 

that  it  is  not  necessarily  increased  during  snow 

events  where  the  daily  maximum  temperature  varies 

according  to  aspect  and  elevation.    The  table 

below  indicates  some  station  characteristics  and 

corresponding  reflectivity  threshold  temperatures. 
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Card 
4 


Contents 


Relative  Elevation 
High 

Low-Middle 
Low-Middle 
All  ranges 
Low 

Middle-High 


Aspect 

North,  East 

East 

North 

West 

South 

South 


32 
40 
45 
45 
60 
70 


Melt  Threshold  Temperature  -  During  initial 
snowpack  accumulation,  the  model  relies  on  a  base 
temperature  to  stop  melt  when  the  mean  daily 
temperature  is  below  that  base.    A  knowledge  of 
the  typical  pattern  of  fall  snow  accumulation  will 
guide  the  user  in  selecting  a  threshold  temperature. 
Areas  where  the  snowpack  accumulates  and  melts 
frequently  might  indicate  a  low  threshold  (32°F.). 
High  thresholds  (40°-45°F.)  may  be  assumed  where 
the  snowpack  may  yield  some  melt,  but  generally 
continues  to  build  once  started. 


46-50 


Melt  Threshold 


F5.0 


Available  Soil  Water  -  Estimate  the  soil  mantle 
recharge  requirement  at  which  water  is  no  longer 
available  for  transpiration.     Examples:  -5.3; 
-7.8;  -10.6  inches. 

Deciduous  Winter  Values  -  The  values  defined  in 
items  4,  5,  and  6  represent  the  foliated  conditions 
of  a  deciduous  forest.    Corresponding  values  must 
be  supplied  for  the  defoliated  state  and  must 
represent  the  reduction  in  cover  density  between 
the  seasons.    The  values  used  most  frequently  for 
cover  density  and  maximum  cover  density  on  aspen 
stands  in  the  central  Rockies  were  .35  and  .20  for 
the  foliated  and  defoliated  states,  respectively. 
The  model  was  allowed  to  generate  the  transmissivity 
coefficients  as  a  function  of  those  cover  densities. 

Latitude  -  Select  38°,  40°,  42°,  or  44° 

Aspect  -  Leave  blank  for  a  horizontal  surface,  or 
select  N,  NNE,  NE,  ENE,  E,  ESE,  SE,  SSE,  S,  SSW, 
SW,  WSW,  W,  WNW,  NW,  OR  NNW 

Slope  -  Leave  blank  for  a  horizontal  surface,  or 
select  10%,  20%,  30%,  or  40% 

Identified  by  the  words  INITIAL  CONDITIONS,  this 
card  provides  these  conditions  on  Oct  1  of  the 
first  water  year: 

Initial  Snowpack  Temperature,  °C. 

Initial  Snowpack  Water  Equivalent,  inches 

Initial  Recharge  Requirement,  inches 

Identified  by  the  words:    DAILY  ET 

Average  Daily  Evapotranspiration  -  Obtain 
estimates  of  the  average  daily  potential 
evapotranspiration  in  inches  for  each  month. 


51-55 


56-60 
61-65 
66-70 


72-73 
75-77 

79-80 
1-20 

21-25 

26-30 

31-35 

1-10 

21-25 
26-30 
31-35 


Available  Soil  Water 


Deciduous  Winter  trans,  coeff 
"        cov.  den. 
"       max.  cov.  den. 


Latitude  (38,40,42,  or  44) 
Aspect  (Left-justified) 

Slope  (10,20,30,  or  40) 
"INITIAL  CONDITIONS" 

Snowpack  Temperature 
Snowpack  Water  Equivalent 
Recharge  Requirement 
"DAILY  ET" 

Average  daily  ET  for  Jan 
"  "  "  "  Feb 
"         "        "      "  Mar 


F5.2 


F5.2 
F5.2 
F5.2 


12 
A3 

12 
2A10 

F5.2 
F5.2 
F5.2 
A10 
F5.2 


Identified  by  the  words  AIR  TEMP  COEFF  +  ADJ 

Air  Temperature  Correlation  Coefficients  -  Supply 
the  correlation  coefficients  for  predicting  the 
daily  extreme  temperatures  in  °F.  from  a  base 
station,  where  the  coefficients  A  and  B  are  of  the 
form, 


subunit 


A  + 


B(T.  ) 
base 


If  the  entire  basin  is  being  considered  as  a  unit 
with  observed  extremes  available,  the  coefficients 
would  be  0.0  and  1.0,  respectively.  Examples: 


Maximum  A  =  4.779 
Minimum  A  =  0.698 


0.907 
1.023 


Specify  a  post-peak  precip  adjustment,  if  desired. 
Example  1.15  =  15%  increase. 


76-80 

1-20 

21-25 
26-30 
31-35 

36-40 


41-45 


"  Dec 
"AIR  TEMP  COEFF  +  ADJ" 


"MAX 
*MIN 


IN 


Post-peak  precip  adjustment 


2A10 
F5.3 


F5.3 
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Card 

8 


Identified  by  the  word:  FORMAT 

Specify  the  format  for  reading  a  data  card.  All 
six  input  items  (month,  day,  year,  max  temp, 
min  temp,  and  precip.)  must  be  read  by  F  formats. 
Read  the  date  variables  by  F2.0 

Specify  the  file  number  (or  data  deck  number)  if 
more  than  one  set  of  data  is  included. 

Specify  the  relative  order  on  the  card  for  the  month. 

day. 


year, 
max  temp, 
min  temp, 
precip. 


Example:     If  the  items  were  ordered  year,  month,  day, 
precip,  temp  max,  and  temp  min,  the  relative  order 
would  be  231564. 

9  Identified  by  the  words:     SPECIFIED  CONDITIONS. 

Include  one  card  for  each  water  year  to  be  simulated. 

Specify  the  observed  peak  water  equivalent. 

Specify  the  date  of  the  observed  peak  W.E. 

Specify  the  date  by  which  the  pack  must  be 
isothermal. 

10  Identified  by  the  words:    END  OF  NATURAL  COND. 

MANAGEMENT  STRATEGY 

Note:    The  results  from  simulating  natural  conditions 
prescribed  by  the  above  cards  are  used  repeatedly  in 
simulating  each  of  the  management  plans  which  make  up 
the  management  strategy.    Thus,  the  above  cards  are 
included  only  once,  and  each  step  (management  plan) 
in  the  management  strategy  is  described  on  a  card  as 
explained  below.    The  cards  which  comprise  the 
strategy  are  collectively  termed  the  management 
strategy  deck. 


Columns 
1-6 
7-70 


72-73 


75 
76 
77 
78 
79 
80 


1-20 

21-25 
32-37 
39-44 

1-20 


Timber  harvesting, 
Identified  by  the  words: 


MANAGEMENT  PLAN 


A  1-5  digit  non-zero  response  unit  (managed  area) 
number  must  be  supplied.     If  more  than  one  area  is  to 
be  managed,  unique  numbers  (not  necessarily  sequential) 
must  be  assigned  to  each  of  them. 

Specify  the  year  of  initial  timber  harvest 

Specify  the  percent  of  the  total  planning  unit  area 
represented  by  this  response  unit.     (.15  =  15%) 

Specify  the  percent  of  the  area  of  the  response 
unit  which  is  subjected  to  timber  harvesting. 
1.00  implies  a  complete  removal  of  forest  cover 
and  the  canopy  will  be  reestablished  with  time; 
.99-. 51  implies  a  partial  removal  of  forest 
cover  with  the  canopy  being  reestablished  with 
time;  and  .50-. 01  implies  a  reduction  in  the 
forest  cover  which  does  not  permit  an  increase 
in  canopy  density  subsequent  to  the  initial  cut. 

Note:     If  all  of  the  boundary  conditions  below  are 
left  blank,  the  assumed  values  for  each  of 
the  hydrologic  functions  will  be  used.  The 
boundaries  are  expressed  in  terms  of  the 
number  of  years  since  the  initial  cut.  The 
lower  boundary  is  the  number  of  years  that 
the  cut  area  retains  the  characteristics  of 
an  opening  if  patch-cut,  and  the  upper 
boundary  is  the  required  number  of  years 
before  the  cut  area  reacts  as  it  did  under 
natural  conditions. 


1-20 


21-25 


28-30 


31-35 


36-40 


Contents 
"FORMAT" 

Variable  Format  (include  parenthesis) 
File  number  on  "UNEDIT" 


Relative  order  for  month 

N  H  II  (Jgy 

"  "         "  year 

"  max  temp 

"  "  min  temp 

"  precip 


"SPECIFIED  CONDITIONS" 

Observed  peak  water  equivalent 
Date  of  peak  W.E.  (MMDDYY) 
Isothermal  date  (MMDDYY) 

"END  OF  NATURAL  COND." 


Format 
A6 
6A10,A4 
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II 


2A10 

F5.2 
312 
312 

2A10 


"MANAGEMENT  PLAN" 
Response  unit  number 

Year  of  cut 
Area  weight 

Percent  cut 


2A10 
15 


13 
F5.0 


F5.0 
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Card  Columns  Contents 

Assumed  Years 
lodge-  spruce- 
pole  fir  aspen 


Soil  Water,  Lower 

15 

30 

7 

43-45 

Lower  boundary, 

soil  water  function 

13 

Upper 

80 

100 

60 

48-50 

Upper       "  , 

13 

Cover  Density,  Lower 

0 

0 

0 

53-55 

Lower        "  , 

cover  density  function 

13 

Upper 

40 

80 

20 

58-60 

Upper       "  , 

13 

Precip  Redist,  Lower 

40 

80 

20 

63-65 

Lower        "  , 

precip  redist.  " 

13 

Upper 

120 

160 

80 

68-70 

Upper        "  , 

13 

Max  increase  due  to 

0.0 

0.0 

0.0 

71-75 

Max  increase  due 

to  precip  redist. 

F5.0 

precip  redist. 
(An  increase  in  precipitation  of 
.30  would  correspond  to  5-8H  patches 
which  occupy  40%  of  the  planning  unit.  In 
this  situation,  the  snowpack  is  increased 
30%  in  the  openings  and  decreased  20%  in  the 
uncut  forest.     For  other  combinations  of 
opening  size  and  area,  the  redistribution 
factor  should  be  adjusted  accordingly.) 


If  a  desired  cover  density  is  known,  rather 
than  a  percent  cut  (col  36-40) ,  specify  the 
desired  cover  density  and  the  model  will 
calculate  the  percent  cut. 


76-80 


Desired  cover  density  (col  36-40  must  be 
blank  if  this  is  included) 


F5.0 


lib 


Weather  modification, 
Identified  by  the  words: 


MANAGEMENT  PLAN 


1-20 


"MANAGEMENT  PLAN" 


2A10 


There  is  no  response  unit  number  since  cloud  seeding  21-25 
affects  the  entire  planning  unit. 

Specify  the  year  cloud  seeding  begins.  28-30 

Specify  the  year  cloud  seeding  ends.  33-35 

Specify  the  month  and  day  that  cloud  seeding  starts  37-40 
in  a  given  year. 

Specify  the  month  and  day  that  cloud  seeding  ends  42-45 
in  a  given  year. 

Specify  the  percent  increase  in  precip  due  to  46-47 
cloud  seeding 


Must  be  blank 


Year  cloud  seeding  begins  13 

Year  cloud  seeding  ends  13 

Date  seeding  starts  (MMDD)  212 

Date  seeding  ends  (MMDD)  212 

Percent  increase  F5.0 


ROAD  CONSTRUCTION 

12  Identified  by  the  words:     ROAD  CONSTRUCTION  1-20  "ROAD  CONSTRUCTION"  2A10 

Note:     The  road  construction  card  should  contain  the 
same  year  as  a  management  plan. 


If  a  road  construction  card  (or  more  than  one)  is 
included,  the  sediment  yield  model  will  execute. 
There  are  no  options  on  its  output,  so  if  it  is  not 
wanted,  exclude  road  construction  cards. 


Specify  the 


year  of  construction. 

28- 

-30 

Year  of  construction 

i) 

number  of  miles  of  road  system 

31- 

-35 

Miles  of  road 

2) 

"effective"  width  of  the  road 

36- 

-40 

Effective  width  of  road 

3) 

index  of  the  normal  rate  of  erosion 

41- 

-45 

Index,  normal  rate 

4) 

index  of  the  soil  available  for 

46- 

-50 

Index,  available  soil 

erosion 

5) 

index  of  the  rate  of  decline  of 

51- 

-55 

Index,  rate  of  decline  (positive  number) 

erosion 

6) 

average  slope  of  the  cut  expressed 

56- 

-60 

Slope  of  cut 

as  tan  6Q  (.20  =  20%) 

7) 

average  slope  of  the  fill  expressed 

61- 

-65 

Slope  of  fill 

as  tan  ^  (.20  =  20%) 

8) 

average  watershed  sideslope  on  which 

66- 

-70 

Slope  of  planning  unit 

the  road  is  constructed 

13 
F5.0 
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Identified  by  the  words:     END  OF  STRATEGY 


1-15 


"END  OF  STRATEGY" 


A210 


The  following  are  the  limitations  of  the 
management  strategy  deck: 

1.    The  cards  must  all  be  in  order  by  the  year 
specified  in  col  28-30.    There  may  be  more 
than  one  card  for  any  given  year,  and  within 
that  year,  no  particular  order  is  mandatory. 
For  example,  in  year  75,  the  management 
strategy  may  require  road  construction  (1  card) 
and  two  response  units  (2  cards) .    All  3  cards 
would  have  year  75. 
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2.  A  maximum  of  7  separate  response  units  may 

be  designated.     However,  an  existing  response 
unit  may  be  reentered  any  number  of  times, 
within  a  limit  of  11  individual  managemental 
strategies. 

3.  A  maximum  of  11  separate  roads  may  be  constructed. 


\ 


PARAMETER  DECK  ORDER 


Decks  1,2, .. .n 
may  be  Planning  Unit  Decks, 
or  Recovery  Decks  in  any 
combination  and  in  any  order 


DATA  DECK 


RECOVERY  DECK 


The  climatological  data  may  be  read  from  cards,  if  the 
card  is  preceded  by  a  card  containing  the  words:     "DATA  DECK" 
in  columns  1-9,  and  terminated  by  a  card  containing  the 
words:    "END  OF  DATA  DECK"  in  columns  1-16.    This  deck  may 
appear  anywhere  in  the  parameter  deck  following  the  region 
cards  (cards  1  &  2) . 


In  the  event  that  a  recovery  deck  is  to  be  run,  the 
recovery  deck  for  any  given  planning  unit  may  be  identified 
from  the  punched  output  by  one  of  the  following  methods: 

1.     Columns  5  and  6  contain  the  optional  2-digit  ID 
discussed  on  the  planning  unit  ID,  or  if  not 
specified, 


DATA  DECK  ORDER 


RECOVERY  DECK  ORDER 


fEN 


END  OF  RECOVERY 


&  1 

r  Recovery  Cards 

^  RECOVERY  DECK 

2.     Column  37  will  contain  a  1,  2,  3,  4,  or  5. 

There  will  be  one  card  for  each  year  in  group  1, 
group  2,  etc.  Therefore,  the  end  of  the  recovery 
deck  in  question  will  be  the  last  card  in  the 
5  group. 

The  deck  must  be  preceded  by  a  card  containing  the  words: 
"RECOVERY  DECK"  in  columns  1-13  and  terminated  by  a  card 
containing  the  words:     "END  OF  RECOVERY  DECK"  in 
columns  1-20.     (If  the  area  weight  is  to  be  changed, 
punch  the  new  weight  in  cols.  66-68  of  the  RECOVERY  DECK 
card;  otherwise,  leave  those  columns  blank.)  The 
recovery  deck  replaces  all  cards  pertaining  to  the 
planning  unit  in  the  parameter  card  deck  (Planning  unit 
deck. ) 
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APPENDIX  D:  COMPLETE  LISTING  FOR 
SUBALPINE  LAND  USE  MODEL 


Program  LUMOD 

0VERL4Y  IOLAYS.Cj) 

PROGKA"  LUMdD  (INPUT=512,nuTPUT=512»DATFIL=65»PLNFIL=65» 

1  PLNLST=5! 2,PR00FD=65,    PUNCH=51  2  .  S  AVNEW=  51  3  ,  S  AV0L0=5  1  3,  S  CRF  !  L  =  65 . 

2  T IMF U =51 2,UNEUIT=512,TAPE5= INPUT, T APE6=0UT PUT , T APE 10=UNE0IT, 

3  TAPE11=0STFIL,TAPE12=PLNFIL,TAPE13=  PUNCH,  T  AP  £  1  4=SAVOL0. 

4  TAPF15=SAVNEW,  T  APE  1 6=  SCRF  I L  •  TAPE  1 7  =  T  I  MF  I L  ,  T  APE  1 8=PLNLST  , 

5  TAPE]9=PR00F0I 


c  this  is  the  controlling  routine  of  the  land  use  planning  model  for 

C  THE   SUBALPINE   ZONE    (WATER,   TIMBER,   SOIL  I 

C  

C  THE   FILE   BUFFER   SIZES  ARE   LIMITED  ABOVE   TO  SAVE  MEMORY .  THOSE 

C   WHICH  HANDLE  FORMATTEO  REAOS  AND  WRITES   ARE   ALLOWED  ABOUT  HALF  OF 

C   THEIR    NORMAL    BUFFER ,    BUT   THOSE   WHICH   ARE   ACCESSEO  ONLY   BY  BUFFER 

C   IN   ANO  BUFFER  OUT  ARE   LIMITED  TO  THE   MINIMUM  BUFFER  SIZE 

C  

C  THE   REGION  FILE    (-RNGFIL-I   WAS  CHANGED  TO  THE  PUNCH  FILE  (-PUNCH-) 

c   TO  PROVIDE  RECOVERY  DECKS   IN  CASE  OF   ABNORMAL   TERMINATION.  BY 

C   OPTION,   THE   USER  MAY  CAUSE   THE   DECK  TO   BE  PUNCHED  EVEN  UNDER 

C   NORMAL   TERMINATION,  BUT   IF   THE   OPTION  IS  NOT  SPECIFIED,   THE  FILE 

C   IS  REWOUND  AND  AN  END  OF   FILE   IS  WRITTEN  WHEN  TERMINATING 

C   NORMALLY 

C  

C  SEDIMENT  YIELD,   AN   INDEPENDENT   SIMULATION  MODEL ,   HAS   BEEN  INCLUDED 

C   WITHIN   THE  GENERAL  FLOW  OF  THE   LAND  USE  MODEL ■     HOWEVER,   THE  ONLY 

C-   FUNCTION  THAT  IS  PERFORMED  BY  THE  LAND  USE  MODEL  FOR  SEDIMENT 

C   MODELING  IS  THAT  OF  PROOFREADING  AND  INPUT  OF  PARAMETERS .  ALL 

C   ROUTINES  OF   THE   LAND  USE   MODEL  WHICH  WERE  MODIFIED  CONTAIN  THE 

C   COMMON  BLOCK  /%/   (EXCEPT  THIS  MAIN  PROGRAM  WHICH  CONTAINS  THE 

C   DICTIONARY  DEFINITIONS  OF  THE  VARIABLES  LISTED  IN  COMMON  BLOCK 

C   /S/>.     THE   SEDIMENT  MODEL   ITSELF   IS   A  SECONDARY  OVERLAY  WHICH  IS 

C   LOADED  AND  EXECUTED  BETWEEN  THE  EXECUTION  OF  THE  MANAGEMENT 

C   SIMULATION  ANO  THE   PRINTING  OF  THE  COMPOSITE   PLANNING  UNIT  OUTPUT 

C  

c  DICTIONARY 

C  AIRTMC  -  THE  MEAN  A I RTEMPER ATURE   IN  DEGREES  CENTIGRADE 

C  ALLOW  =  0,   00  NOT  ALLOW  ANY  INTERCEPTION 

C  =1,   INTERCEPTION  ALLOWED 

C  ALTYR  -   YEAR  OF   MANAGEMENT   PLAN  ON  GIVEN  RESPONSE  UNIT 

C  AVSOIL  -   SEOIMENT  MODEL,   AN   INDEX  OF  THE  AMOUNT  OF   SOIL  AVAILABLE 

C  FOR  EROSION 

C  BIHNTH  -  ARRAY  FOR  ACCUMULATING  BIMONTHLY  TOTALS   FOR  GENERATEO 

C  RUNOFF   DURING  THE   SNOWMELT  SEASON 

C  BLOCK  -  DATA  ARRAY  FOR  TRANSFER  OF  ONE  ENTIRE  YEAR  TO  AND/OR  FROM 

C  TAPE  FILES 

C  (II   -  YEAR  AND  ID,  YY.IO 

C  (2)   -   (373)   -  MAXIMUM  TEMPERATURE 

C  137*1  -  (745)  -  MINIMUM  TEMPERATURE 

C  (746)  -  11117)  -  ACCUMULATED  PRECIPITATION 

C  (11181   -   (1489)   -   INCIDENT   SHORTWAVE  RAOIAT ION 

C  (14901   -   (1861)   -  ENERGY  ADJUSTED  EVAPOTRANSPIRATION 

C  (1862)  -  TRANSMISSIVITY  COEFFICIENT 

C  118631   -  COVER  DENSITY 

C  (1864)    -   MAXIMUM  COVER   OENS ITY 

C  (1865)   -  VEGETATION  TYPE 

C  (18661   -  REFLECTIVITY  THRESHOLD 

C  (1867)   -  MELT  THRESHOLD 

C  (1868)  -  WILTING  POINT 

C  (1869)   -  DECIDUOUS  WINTER  TRANSMISSIVITY  COEFFICIENT 

C  (1870)  -  DECIDUOUS  WINTER  COVER  DENSITY 

C  (18711  -  DECIDUOUS  WINTER  MAXIMUM  COVER  DENSITY 

C  (18721  -  SPECIFIED  ISOTHERMAL  OATE  ( PSEUDO-JUL IAN  I 

C  11873)   -  SPECIFIED  PEAK  WATER  EQUIVALENT  DATE  (PSEUDO 

C  JULIAN) 

C  (1874)   -   INITIAL  WATER  EQUIVALENT 

C  (1875)  -  INITIAL  RECHARGE  REQUIREMENT 

C  (1876)   -  YEARLY  TOTAL  GENERATEO  RUNOFF 

C  (1877)   -  YEARLY  TOTAL  EVAPOTRANSPIRATION 

C  (1878)   -  CHANGE   IN  RECHARGE  REQUIREMENT   OVER  THE 

C  WATER  YEAR 

C  (1879)   -  CHANGE   IN  THE  SNOWPACK  WATER  EQUIVALENT  OVER 

C  THE  WATER  YEAR 

C  (18801   -  APRIL  16-30  GENERATED  RUNOFF 

C  (1881)    -  MAY  1-15  GENERATED  RUNOFF 

C  (1882)   -  MAY   16-31  GENERATED  RUNOFF 

C  11883)  -  JUNE  1-15  GENERATED  RUNOFF 

C  118841   -   JUNE   16-30  GENERATED  RUNOFF 

C  (1885)  -  JULY  1-15  GENERATEO  RUNOFF 

C  (1886)   -  ACTUAL  PEAK  WATER  EQUIVALENT 

C  118871    -  ACTUAL  PEAK  WATER   EQUIVALENT   DATE  (PSEUDO- 

C  JULIAN) 

C  11888)   -  PEAK  7-DAY  GENERATED  RUNOFF 

C  (1889)   -  DATE   OF  FIRST  DAY   OF  PEAK  7-DAY  GENERATED 

C  RUNOFF 

C  BOUNO  -  THE  BOUNDARIES   ON  THE   TIME  FUNCTIONS 

C  (1)  -  NUMBER  OF  YEARS  BEFORE  REGROWTH  BEGINS  TO 

C  INCREASE  SOIL  WATER  USE 

C  (2)   NUMBER  OF  YEARS  WHEN  REGROWTH   IS  COMPLETE  AS  FAR 

C  AS  SOIL  WATER  USE  IS  CONCERNED 

C  (31  -  NUMBER  OF  YEARS  BEFORE  REGROWTH  BEGINS  TO  ALTER 

C  THE  COVER  DENSITY  AND  CANOPY  REFLECTIVITY 

C  (41   -  NUMBER  OF   YEARS  WHEN  REGROWTH  IS  COMPLETE  AS 

C  FAR   AS  CANOPY  REFLECTIVITY   IS  CONCERNED 

C  (4)  -  NUMBER  OF  YEARS  BEFORE  REGROWTH  BEGINS  TO  ALTER 

C  THE   PRECIP  REDISTRIBUTION  FACTORS 

C  (6)    -   NUMBER   OF   YEARS   WHEN   REGROWTH    IS   COMPLETE  AS 

C  FAR  AS  PRECIP  REDISTRIBUTION  IS  CONCERNED 

C  CALDEF  -  THE  CALORIE  DEFICIT   IS  THE  NUMBER  OF  CALORIES  NEEOEO 

C  TO  BRING  THE   SNOWPACK  TEMPERATURE  TO  ZERO  DEGREES 

C  CENTIGRADE   (NOTE  SHOULD  BE   MADE  THAT   IS   IS  A  POSITIVE 

C  QUANTITY) 

C  CANRFF    -    THE    FACTOR   FOR    ADJUSTING   THE    EVAPOTRANSPIRATION  FOR 

C  CANOPY   DENSITY    (RECOMPUTED    EACH   YEAR   UNDER  THE 

C  MANAGEMENT    STRATEGY    TO    INCORPORATE   THE    EFFECTS  OF 

C  REGROWTH) 

C  COMSX  -  MAXIMUM  COVER  DENSITY  ON  THE   PLANNING  UNIT 


C  CDMA  X2   -   HALF    OF    -CDMAX-.      USED   AS    THE   CRITICAL    POINT    IN  SELECTION 

C  CUTTING   TO   DETERMINE   WHETHER   OR    NOT    THE   WATER  BALANCE 

C  ROUTINES  ARE   TO  BE   ALTERED   BY  THE   TIME  TRENDS 

C  CHANGR   -   CHANGE    IN   THE    RECHARGE    REQUIREMENT   OVER   THE   WATER  YEAR 

C  CHANGW  -   CHANGE    IN   THE    SNOWPACK   WATER   EQUIVALENT   OVER   THE  WATER 

C  YEAR 

C  CONAV  -    THE    TIME    DEPENDENT   CONSTANT   FOR    ADJUSTING  EVAPOTRANSPIRA- 

C  TION  FOR   AVAILABLE   SOIL   WATER    (RECOMPUTED   EACH  YEAR 

C  UNDER   THE    MANAGEMENT   SIMULATION   TO    INCORPORATE  THE 

C  EFFECTS  OF  REGROWTH) 

C  COVDEN   -    THE   COVER   DENSITY   IS   THE   FRACTION  OF   THE  GROUNO  OR  SNOW 

C  SURFACE    SHADED   FROM   DIRECT    SUNLIGHT   OR  RADIATION 

C  CUT   -  THE   PERCENT  OF   THE  COVER  DENSITY  REMOVED  (0.0  THROUGH  1.0). 

C  SEE  -SPECCD- 

C  OATE   -   MONTH,  DAY 

C  DATES  -    SAME    AS   -OATE-   BUT   FOR   TWO  DATES 

C  DAT  I  ME   -  DATE  AND  TIME   OF  RUN   IN  ALPHANUMERIC  FORMAT  AS  FOLLOWS 

C  HM.OO.YY  HH.MM.SS. 

C  DCDMAX  -   THE   WINTER   VALUE  FOR  -CDMAX-  ON  OECIOUOUS  FORESTS 

C  DECIDS  -  An  ARRAY  USED   IN  WORKING  WTIH  DECIDUOUS   FORESTS  FOR 

C  RETAINING  THE  COVER  DENSITY,   MAXIMUM  COVER  DENSITY 

C  AND  TRANSMISSIVITY  COEFFICIENT  FOR  ONE   SEASON  WHILE 

C  THE  OTHER  IS  BEING  PROCESSED.     (IN  OTHER  WOROS,  WHILE 

C  OPERATING  DURING  THE  SUMMER ,  THE  WINTER  VALUES  ARE 

C  STORED.      LIKEWISE,    IN  THE   WINTER,    THE    SUMMER  VALUES 

C  ARE   STORED.     LOCATION  1   IS   FOR  THE  TRANSMISSIVITY 

C  COEFFICIENT,   2   IS  FOR  THE  COVER  DENSITY   AND  3   IS  FOR 

C  THE  MAXIMUM  COVER  DENSITY) 

C  DECLIN  -  SEOIMENT  MODEL,   AN   INOEX  OF  DECLINE  OF  EROSION  FOLLOWING 

C  DISTURBANCE 

C  DECMAL  -  OPTIONAL  TWO  DIGIT   INTEGER  WHICH  IDENTIFIES  THE  FILES  ON 

C  -SAVNEW-.     EACH  PLANNING  UNIT  MAY   BE  GIVEN  AN  ID 

C  WHICH    IS   THEN  APPENDED   AS    A   DECIMAL   TO   THE   YEAR  IN 

C  EACH  BLOCK  OF   THE  FILE.     THE  NUMBERIC  VALUE  THUS 

C  BECOME  YY.ID 

C  DREAOY   =  0,   OIFFUSION  MODEL   (SUBROUTINE   DIFMOO)   NOT  INITIALIZED 

C  =1,   DIFFUSION  MODEL  INITIALIZED  AND  READY  FOR  SNOWPACK 

C  TEMPERATURE  SIMULATION 

C  =  -1,  DIFFUSION  MODEL  MAY  NOT  BE  USED 

C  ETDALY  -  ARRAY  OF  DAILY  AVERAGE  EVAPOTRANSPIRATION  FOR  EACH  MONTH 

C  ETFROM   =   1,   EVAPORATION  IS  FROM  THE  CANOPY 

C  =2,  EVAPORATION  IS  FROM  THE  SURFACE  OF  THE  SNOWPACK 

C  *  3,   BOTH  1   AND  2 

C  ■  4,   EVAPOTRANSPIRATION   IS  FROM  SNOWMELT,   RAIN  OR  THE 

C  SOIL  MANTLE  STORAGE 

C  ETO  -  ARRAY  OF   POTENTIAL  EVAPOTRANSPIRATION  VALUES   ( ALREADY 

C  ADJUSTEO  FOR   SLOPE,   ASPECT,   ETC  I   FOR  AN  ENTIRE  YEAR 

C  EVAPTR  -  WHEN  FIRST  RECEIVED,  THIS  VARIABLE  IS  THE  POTENTIAL 

C  EVAPOTRANSPIRATION  AS  COMPUTED  BY  THE  HAHON  METHOD 

C  AND  ADJUSTED  FOR  AVAILABLE  RADIATION.     AFTER  ACTION 

C  IS  TAKEN  BY  THE  WATER  BALANCE  ROUTINES,   THE  ORIGINAL 

C  VALUE  HAS   BEEN  ADJUSTED  FURTHER   8Y  THE  METHODS 

C  DISCUSSEO   IN   SUBROUTINES  CANVAP,   EVTRAN,   AND  SNOWVAP. 

C  IT  THEN  REPRESENTS  THE  EVAPOTRANSPIRATION  DURING  THIS 

C  INTERVAL 

C  EXPK   -    THE   -K-   FROM    THE    TIME   FUNCTION  FOR  COMPUTING  THE  AVAILABLE 

C  SOIL  WATER  ADJUSTMENT  FACTOR 

C  EXPK1  -  THE  -Kl-  FROM  THE   TIME  FUNCTION  FOR  COMPUTING  THE  PRECIP 

C  REDISTRIBUTION  FACTOR 

C  FORNXT  -  A  UTILITY  ARRAY  WHOSE  ONLY  PURPOSE   IS   FOR  READING  ANO 

C  WRITING  CURRENT   MODEL  CONDITIONS  ON  THE  SCRATCH 

C  FILE.     IT  IS  EQUIVALENCED  WITH  THE  ENTIRE  COMMON 

C  BLOCK  /M/.     SEE  -L4NXT- 

C  FRACTN  -THE  FRACTIONAL  PART  NEEDED   IN  THE   INTERPOLATION  BETWEEN 

C  TABLE  VALUES   IN  THE  COMPUTATION  OF  THE  RADIATION 

C  GENRO  -  DAILY  GENERATED  RUNOFF 

C  INFILE  *  IG,  DATA  IS  ON  FILE  -UNEDIT-.     SEE  -NFILE- 

C  •  14,   OATA  IS  ON  FILE   -SAVOLD-   IN  STANDARD  MODEL  FORMAT 

C  ISOTRM  -  THE   MANDATORY   ISOTHERMAL  OATE   (NOTE,   MUST  BE   IN  THE 

C  CALENDAR  YEAR  WICH  CORRESPONDS  TO  THE  WATER  YEAR. 

C  THAT  IS,   IT  MUST  BE   BETWEEN  JAN  1   AND  SEP  301 

C  LAST1  -  RETAINS  THE  OLD  VALUE  OF  -NEXTYR-  WHEN  A  NEW  ONE   IS  READ 

C  LCOPY  -   ARRAY   FOR  COPYING   LINES   FROM  ONE   FILE   TO  ANOTHER 

C  LINES  -  LINE  COUNTER 

C  NAME  -  AN  ALPHANUMERIC   IDENTIFIER  USED  PRIMARILY  TO  VERIFY  THE 

C  PARAMETER  CARD  OROER.     ALSO  USED   IN  ARRAY  FORM  AS 

C  IDENTIFIERS  FOR   THE  PRINTOUTS  DURING  THE  PLANNING 

C  UNIT  AND  REGION  PHASES 

C  NDAY  -   THE   PSEUDO  JULIAN  WATER  YEAR  DATE   (1  =  OCT  1) 

C  NEXTYR  -  THE   YEAR  ON  THE  NEXT  MANAGEMENT  PLAN 

C  NFILE  -  THE  NUMBER  OF  THE  FILE  ON  -UNEOIT-  WHICH  CONTAINS  THE  OATA 

C  FOR   THIS  PLANNING  UNIT 

C  NPLAN  -   THE  NUMBER   OF   THIS   PLAN   IN  THE  SEQUENCE  MAKING  UP  THE 

C  MANAGEMENT  STRATEGY 

C  NRMANG  -  A  SWITCH  INDICATING  THE   MODE  OF  OPERATION   (0  OR   1   IS  FOR 

C  THE  NORMAL   SIMULATION,   2  FOR  MANAGEMENT) 

C  NROADS  -   SEDIMENT  MODEL ,   THE   NUMBER  OF  TIMES   ROADS  WERE 

C  CONSTRUCTED  DURING  A  MANAGEMENT  STRATEGY  PERIOD 

C  NSAVED  -  NUMBER  OF   FILES  WRITTEN  ON  -SAVNEW-  DURING  THE  RUN 

C  NUM  -   THE  RESPONSE   UNIT  CODE   ON  THE   NEXT   MANAGEMENT  PLAN 

C  NUN  I T  -   THE   NUMBER   OF   RESPONSE  UNITS   AT   ANY  GIVEN  POINT    IN  TIME 

C  NYE ARS   -   NUMBER    OF    YEARS   FOR   MANAGEMENT    STRATEGY    (IF    THE  ORIGINAL 

C  DATA  BASE   DOES  NOT  HAVE   THIS  NUMBER   OF   YEARS,    IT  WILL 

C  BE   EXPANDED  OR  CONTRACTED  AS  NEEOEO) 

C  PARAM  -   AN   ARRAY   OF    PARAMETERS   READ   FROM   THE   MANAGEMENT   PLAN  CARD 

C  (II   -  RESPONSE   UN  I T  WEIGHT 

C  121   -  PERCENT  CUT 

C  (31   -   (8)   -  CORRESPONDS  TO  -BOUND(l)  -  (6)- 

C  (9)   -  MAXIMUM   INCREASE   IN  PPT  DUE   TO  REDISTRIBUTION 

c  peaked  =  :,  the  peak  water  equivalent  has  not  been  reached 

C  =1,    THE   PEAK  WATER  EQUIVALENT  HAS   BEEN  REACHED 

C  PEAKRO   -    THE    YEARLY   7   OAY   PEAK  RUNOFF 

C  PCAKWE    -   THE    YEARLY   PEAK   WATER  EQUIVALENT 

C  PEKDAT   -   THE    SPECIFIED   PEAK   WATER   EQUIVALENT  DATE 

C  PEKPPT  -   THE   OBSERVED  ACCUMULATED  PRECIPITATION  ON  THE  SPECIFIEO 

C  PEAK   WATER    EQUIVALENT  OATE 

C  PHISO  -   PHI    SOUAREO,    USED    IN   THE   TIME    FUNCTIONS    FOR   COVER  DENSITY 
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c  and  canopy  r:flectivity 

C  PL\0»T    -   AR..AY  Cf   OUTPUT   OPTIONS    F OR    PLANNING  UNIT    PHASE    (0    =  NO 

C  OUTPUT,    I    =    PRINT  OUTPUTI 

C  III   -  OETAILFD  YEARLY  OUTPUT  FOR  NORMAL  SIMULATION 

C  (21    -   LIST   OF    YEARS    IN  ORIGINAL    OAT  A   BASE    ANO  THOSE 

C  iENEKATEO  OURING  EXTENSION  OF  THAT  DATA  BASF 

C  131    -    DETAILED   YEARLY   OUTPUT   FOR  MANAGEMENT 

C  SIMULATION 

C  141    -   LIST   OF    CHANGES    MADE    BY   THE    TIME  TPENOS 

C  FUNCTIONS 

C  SUMMARIES    FOR    PLANNING  UNIT    C«NO   OUTPUT,  1=ACTUAL 

C  TOTALS,  2*01 FFERENCES  ANO  PLOT  OF  DIFFERENCES, 

C  3*I19TH  \   ANO  2) 

C  151    -  GENERATED  RUNOFF 

C  (61    -  PRECIPITATION 

C  (71    -  EVAPOTRANSPIRATION 

C  (Bl   -  C u A Nb r   IN  RECHARGE  REQUIREMENT 

C  (91   -  CHANGE  IN  SNOWPACK  WATER  EQUIVALENT 

C  11*1-115)   -  3 1  MONTHLY  GENERATED  RUNOFF  DIFFERENCES 

C  \N0  PLOTS   IC=NONE   WANT  ED ,   2    IN   110)    IMPLIES  ALL) 

C  (161-1171    -    SNOWPACK    PEAK   HATER    EQUIVALENT    AND   OAT  t , 

C  DIFFERENCES   AND  PLOTS    (0=NEITHER  WANTED,    2   IN  116) 

C  IMPLIES  BOTH) 

C  (1BI-II))    -    PEAK   7-DAY   GENERATEO   RUNOFF    AND  STARTING 

C  DATE,  DIFFERENCES  AND  PLOTS   ( 0=NE I THER  WANTED,  2 

C  IN   118)    IMPLIES  BOTH) 

C  PLUNIT   -   60  CHARACTER   NAME    AND/ OR   DESCRIPTION   OF    THE   PLANNING  UNIT 

C  POTENT   -    ARRAY  OF   POTENTIAL    INCIDENT    SHORTWAVE    RADIATION   VALUES  AT 

C  APPROXIMATELY   TWO  WEEK    INTERVALS   THROUGH  THE  YEAR 

c  potrad  -  the  interpolated  value  selected  from  -potent- 

C  PPT   -   ARRAY   OF    ACCUMULATED   PRECIPITATION    FOR   THE   ENTIRE  YEAR 

C  PPT'JOw  -   THE   OBSERVED  ACCUMULATED  PRECIP  UP  TO  THE   DAY  BEING 

C  PROCESSED 

C  PR  EC  IP  -  DAILY  PRECIPITATION  AMOUNT 

C  PREWEQ  -  PREOICTED  SNOWPACK  WATER  EQUIVALENT 

C  RAD    -   ARRAY   OF    THE    RADIATION    (ALREADY    ADJUSTED   FOR    SLOPE,  ASPECT, 

C  ETC.)   FOR  THE  ENTIRE  YEAR 

C  RAOIN  -  RADIATION  IN   IS   THE   TOTAL   INCIDENT   SHORT  WAVE  RAO  I  AT  I  ON 

C  RADLWN  -  tiET  LONG  WAVE  RADIATION  IS  THE  ALGEBRAIC  SUM  OF  THE  LONG 

C  WAVE  RADIATION  FROM  THE  FOREST  AND  THE  LONG  WAVE 

C  RADIATION  LOST  BY  THE   SNOWPACK   TO   THE  CANOPY 

C  RAOSUD  -   SUBSCRIPT  USED   IN  THE   CALCULATION  OF  -POTRAD- 

C  R  AD  S  WN  -   THE   CALORIC   INPUT   TO  THE   PACK  BY  THE   NET   SHORT  WAVE 

C  RAU1ATI0N 

C  RATNRM   -    SEDIMENT   MODEL,    AN   ESTIMATE   OF    THE    LONG-TERM  NORMAL 

C  EROSION  RATE 

C  RCHRGG  -  THE  RECHARGE  REQUIREMENT  AT  THE  BEGINNING  OF  THE  WATER 

C  YEAR 

C  RDIST  -  THE  FACTOR  FOR  REDISTRIBUTING  THE  PRECIP 

C  ROMAX  -  THE  MAXIMUM  INCREASE   IN  PRECIP  DUE  TO  REDISTRIBUTION 

C  RECHRG  -  RECHARGE  REQUIREMENT  OR  SOIL  MANTLE  STORAGE  DEFICIT 

C  RECOVR  =  3f  DO  NOT  PUNCH  RECOVERY  DECKS  UNDER  NORMAL  TERMINATION 

C  1,   PUNCH  RECOVERY  DECKS  EVEN  UNDER  NORMAL  TERMINATION 

C  REGION  -  80  CHARACTER  NAME  AND/OR  DESCRIPTION  OF  REGION 

C  REGCPT  -   ARRAY  OF   OUTPUT  OPTIONS   FOR   REGIONAL  PHASE   10   =  NO 

C  OUTPUT,   1   =  PRINT  OUTPUT  I 

C  SUMMARIES  FOR  REGIONAL  PHASE 

C  111   -  GENERATED  RUNOFF 

C  (21    -  PRECIPITATION 

C  (31   -  EVAPOTRANSPIRATION 

C  14)  -  CHANGE   IN  RECHARGE  REQUIREMENT 

C  (5)   -  CHANGE   IN  SNOWPACK  WATER  EQUIVALENT 

C  REGR0WI1,-)   -  SEE  -CONAV- 

C  12,-1  -  SEE  -CANREF- 

C  RO  -   ARRAY  OF   DAILY   GENERATEO  RUNOFF  FOR   AN  ENTIRE  YEAR 

C  ROAOHI  -  SEDIMENT  MODEL,   THE  NUMBER  OF  MILES  OF  ROAD  CONSTRUCTED 

C  ROADW  -  SEDIMENT  MODEL ,  THE  EFFECTIVE  WIDTH  OF  THE  ROAD 

C  RUNUH  -  THE  RESPONSE  UNIT  CODES 

C  RUWT  -  THF  PERCENT  OF  THE  PLANNING  UNIT  REPRESENTED  BY  EACH 

C  RESPONSE  UNIT 

C  SAVE   =  3i  DO  NOT  SAVE  THE  EXTENDED  DATA  BASE 

C  =1,   SAVE  THE  cXTENOEO  DATA  BASE  ON  -SAVNEW-.  (NOTE, 

C  -SAVNEW-  IS  NOT  POSITIONED  FOR  THE  SAVING  OF  THE  FILE 

C  WITHIN  THE  RUN  -  THE  USER  MUST   REWIND  OR   POSITION  IT 

C  BEFORE  EXECUTION.     THE  LIST  AT  THE  END  OF  THE  RUN 

C  WILL   INCLUOEO  ALL  FILES  CURRENTLY  ON  -SAVNEW-1 

C  =2,   SAME  AS  1   EXCEPT  ALL  OF  THE  FILES  FROM  -SAVOLD-  ARE 

C  COPIED  TO  -SAVNEW-  AFTER  THE  PROOFREADING  PHASE  AND 

C  BEFORE  THE  EXECUTION  PHASE 

C  SEDINC  -THE  PERCENT   INCREASE   IN  PRECIP  DUE  TO  CLOUD  SEEDING 

C  SFDRN2  -  SEED  FOR  R ANDOH  NUMBER  GENERATOR,  USED   IN  EXTENDING  THE 

C  ORIGINAL  DATA  BASE  TO  A  SPECIFIED  NUMBER  OF  YEARS 

C  SEEOAT  -  THE  DATES  OF  CLOUD  SEEDING  (MMDD  THROUGH  MMOO) 

C  SEEDYR  -  THE  YEARS  OF  CLOUO  SEED 

C  SEEDYR  -  THE  YEARS  OF  CLOUD  SEEDING   IY1   THROUGH  Y2I 

C  SIMTM1   -  AN  ARRAY  USED  PRIMARILY   IN  SUBROUTINE   DIFMOO  IN  THE 

C  SIMULATION  OF   THE   AVERAGE   SNOWPACK  TEMPERATURE 

C  SLPASP  -   THE   SLOPE/ASPECT  ADJUSTMENT  FACTORS   FOR  TRANSLATING  THE 

C  VALUES    IN   -POTENT-   TO  THE    INDIVIDUAL  STATION 

C  SPECCO  -   IF   THE   MANAGEMENT   PLAN   SPECIFIES  A  COVER  DENSITY  RATHER 

C  THAN  A  PERCENT  CUT   ISEE  -CUT-),  THE  MODEL  WILL 

C  CALCULATE    THE   PERCENT   OF  THE  COVER   DENSITY  THAT  MUST 

C  BE   REMOVED  TO  ACHIEVE  THE  SPECIFIED  COVER  OENSITY 

C  SUMNER  -  THE   POST-PEAK  PRECIPITATION  ADJUSTMENT  FACTOR  (EXPRESSED 

C  AS  A  DECIMAL  PERCENT  OF  THE   SUMMER  BASE  STATION 

C  PRECIP.     EXAMPLE  1.051 

C  TANCUT  -   SEDIMENT  MOOEL,   THE   SLOPE   OF  THE  CUT    IN  ROAD  CONSTRUCTION 

C  AS  A  PERCENT 

C  T  ANF  I L    -    SFDIMEMT   MODEL,    THE    SLOPE   OF    THE   FILL    IN  ROAD 

C  CONSTRUCTION  AS  A  PERCENT 

C  TANRHO  -  SEDIMENT  MOOEL ,   THE  AVERAGE   SLOPE  AS  A  PERCENT  ON  WHICH  A 

C  °OAD   I S  CONSTRUCTED 

C  TCOEFF   -    THE    TRf.NSMISSIVlTY   COEFFICIENT   USED  TO    ESTIMATE    THE  NET 

C  SHCPT   WAVE   RADIATION  PEACHING   THE  SNOWPACK 

C  TMA  X   -    ARP  AY   OF    DAILY   MAXIMUM   TEMPERATURES    FOR    AN   ENTIRE  YEAR 

C  THIN  -   :R?iY  OF  DAILY  MINIMUM  TEMPERATURES  FOR  AN  ENT IRE  YEAR 

C  TWAX  -  THE   "AXIMUM  TEMPERATURE   DURING  THE   INTERVAL    IN  DEGREES 

C  FARENHE1T 

C  IMP* IN  -   THE   "Ii.Imum  TEMPERATURE  DURING  THE   INTERVAL   IN  DEGREES 

C  FARENHEIT 

C  TF'PXLT    -    THE    TEMPERATURE    BELOW   WHICH   THE    FALL    RADIATION  ROUTINE 

C  MAY  NOT  CREATE  MELT  OR  FREE  WATER 

C  TYPCUT    =          THIS    TYPE   OF    CUT    DOES   NOT   HAVE  REDISTRIBUTION 

C  ASSOCIATED   WITH  IT 

C  =      ,    THIS   TYPF    OF   CUT   HAS    REDISTRIBUTION   ASSOCIATED   WITH  IT 

C  V£RF"T    -   VARIABLE   FORMAT    FOR   READING   FROM   FILE  -UNEDIT- 


C  VAR1\   -    INPUT   ARRAY    TO   BE    READ   BY   — VARFMT-    I  ALLOWS    THE  VARIABLES 

C  TO   eS    IN   ANY   ORDER    AT    INPUT  TIME) 

C  VEGTYP    -    1,    FOREST   COVER    PREDOMINATELY   LODGEPOLc  PINE 

C  =2,   FOREST  COVER   PREDOMINATELY  SPRUCE-FIR 

C  -   ?f   FnRt  ST  COVER   PREDOMINATELY   ASPEN  (DECIDUOUS) 

C  =  4,    PITER'IAL  USE   ONLY  TO  SPECIFY   DEFOLIATED  OECIOUOUS 

C  FORESTS    (DURING   THE  WINTER) 

C  WATRII.    -    THE    SUM   OF    ANY    SNOWMF  LT    AND   ANY   RAIN   WHICH  PROVIDES 

C  DIRECT    INPUT    TO    THE    WATER  EALANCF 

C  HE   -    ARRAY   r.F    DAILY    PACK   WATER    EQUIVALENTS    FOR    AN   FNTIRE  YEAR 

C  WEICHT  -  THE  PERCENT  OF  THE  REGION  AREA  REPRESENTED  BY  THIS 

C  PLANNING  UNIT   (A  OECIMAL  PERCENT  BETWEEN  CO  ANO  1.01 

C  WE"   -   THE    SNOWPACK   WATER   EQUIVALENT   AT   THE   BEGINNING  OF   A  WATER 

C  YEAR 

C  WILTPT    -    THE    WILTING  POINT 

C  YEAR  -  CUPRENT  YEAR  BEING  PROCESSED 

C  YRC'-ST   -    SCDIMENT   MODEL,    YEAR   OF    ROAD  CONSTRUCTION 

C  YRTOT   -    ARRAY  OF    THE    YEARLY    ACCUMULATED   VALUES    OF   THE  CONTINUITY 

C  EQUATION 
C  

COMMON  DATIMF  (2  I  ,OEC MA L , NR MANG , NS AVED , NY E ARS . PLNOPT (  1 9  I , PL  UN  I T I  6  I , 
1  REC?VR,REGI0N(8I .REGOPT(S) , SAVE , SEDRN2 , WE IGHT 

INTEGER   DAT  I  ME, PLNOPT, PL  UN  IT, RECOVR, R EG  1  ON, RFGOPT, SAVE, SEDRN2 
C  PROOFREAD    THE   CARD  DECK 

CALL  OVERLAY  (5HOLAYS,7,0) 
C  IF   SPECIFIED,   COPY  -SAVOLD-  TO  -SAVNEW- 

IF(S«VE.EQ.2)  CALL  OVERLAY   ( 5H0L AYS ,3,0) 

C  READ   A   PLANNING   UNIT  CARD 

20  READ   119)   PLUNIT, OEC MAL , I NF I L E , WEIGHT, PLNOPT 
C  AT   THE   ENO  OF   FILE,   PROCESS  THE   REGIONAL  FILE 

IFIE0r(19l)  80,30 

C  IF  -INFILF-   IS  1*,   THE   NORMAL   SIMULATION  AND  EXPANDED  DATA  FILE 

C   WERE  SAVED  FROM  A  PREVIOUS  RUN.     FIND  THE  FILE  ON  -SAVOLO-  ANO 

c   [f    it  HAS  THE   SPECIFIED  NUMBER  OF  YEARS,  COPY   IT  TO  -OATFIL-  AND 

C   JUMP  DIRECTLY   TO  THE   MANAGEMENT  PLANS   SIMULATION.  OTHERWISE, 

C   COPY  IT  TO  -SCRFIL-  AND  JUMP  TO  CREATE  THE  SPECIFIED  NUMBER  OF 

C  YEARS 

3S  IFUNFILE  -  14)   50, 40 

40  CALL  OVERLAY   I 5H0LAYS, 1,0) 
I F I NRMANG  J  70,60 

C  PROCESS   THE   NORMAL    SIMULATION  AND  GENERATE   THE   ORIGINAL   DATA  FILE 

50  NRMANG   =  1 

60   CALL    OVERLAY    I 5H0L A YS ,2,0) 

C  PERFORM   THE   MANAGEMENT   PLANS  SIMULATION 

70  NRMANG  =  2 

CALL  OVERLAY   I 5H0LAYS, 2 ,0 1 

c  SUMMARIZE   THE  RESULTS  FOR   THIS   PLANNING  UNIT   AND  GO  ON  TO  THE  NEXT 

CALL   OVERLAY   I 5H0LA YS , 4 ,0 ) 
GO  TO  2* 

C  REGIONAL  SUMMARY 

80  CALL  OVERLAY   ( 5H0LAYS,5,0I 

IFIRECOVRI  100,90 
90  REWIND  13 
END  FILE  13 
C  |F  AMY  FILES  WERE   SAVED,   LIST  THEM 


100   IF! SAVS.NE.O)   CALL  OVERLAY   I 5H0LAYS ,6 ,0 1 

C  TERMINATE  THE  RUN 

END 


Subroutine  GDATE 


SUBROUTINE   GDATE    ( NDAY , DATE ) 

C  CONVERT  THE  PSEUDO-JULIAN  DATE  TO  MONTH  AND  DAY 

INTEGER   DATE  I  2) .MONTHS! 121 
DATA  MONTHS/10, 11, 12, 1,2. 3, 4, 5, 6, 7, 8, 9/ 
DATE ( 2 )   =  M0D1NDAY,31I 
IFI0ATEI21I   13, 2C 
10  OATE(l)    =  MONTHS ( (NDAY/31 1*1  I 

RETURN 
20  DATE ( 2  I   ■=  31 

DATE ( 1 )    =  MONTHSINDAY/31) 

R  E  TURN 

END 


Subroutine  GETREC 


SUBROUTINE   GETREC    ( I F I LE , ARR AY , N , I  END  I 

C  READ  A  RECORD 

DIMENSION   ARRAY! II 

BUFFER    IN    IIFILEil)    ( ARRAY ( 1  I  , ARRAY ( N ) 1 
IF1U iIT( IFILEI )  10,20,30 

C  OK  TO  PROCEED 

10  I  END  =  0 
RETURN 

C  END  OF  FILE 

2C   IEN0  =  1 
RETU°N 

C  PARITY  ERROR 

30  WRIT:    (6.9KI  IFILE 
910  F3RMAT(«CPAPITY  ERROR  ON  FILE»I3,»  WHILE  READING  -  JOB  ABOR T FD* I 
CALL  ABORT 
ENO 


Subroutine  PUTREC 


SUBROUTINE    PUTREC    (IFILE, ARRAY, N) 

C  WRITE  A  RECORD 

OIKENSIO.N  ARRAY  I  1  I 

BUFFER   OUT    IIFILEil)    (ARRAY!  1  I  ,ARRAY(NI  I 
IF(UNITMFILE)  I  10,10,20 
10  RETURN 

2C   WRITT    (<-,9i:i  IFILE 
910  FORM\T(*"PARITY  ERROR   ON  FILE«I3,*  WHILE   WRITING  -   JOB  ABORTED*) 
CALL  ABORT 
END 
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Program  GETOLD 


OVERLAY  IOLAYSil.0) 
PROGRAM  GC  TOLO 

C  GET   in"  DATV  FILE  FOG"  -SWOLD- 

COMMO:.   ')A  TIME  IZI  .DEC MIL.N'MANG.NSAVED. NYE ARS, PLNOPT!  19)  t  PL  UN  I  T  (  6  )  ■ 
1  RECOVP.Rl-GION(B) .REGOPTI5) , S AVE , SEORN2 , WF IGHT 
I'iTESER   D1TIUE  .  PL'IOPT.PLU'II  T.RECOVR  ,R  E  G  I  ON .  R  EG  OPT  ■  SAVE  ,  SEDRN2 
DIMENSION  BLOCK  I  1331)  ,  IOC) 
CALL  CGR E  (-11 
JfMO  =  ■ 

c  prepjr:  the  data  file  and  get  an  io  recorp 

10   C'.LL    GFTREC    I  14  ,  IG.9.IEND) 

C  IF   THE   "NO  OF  FILE   HAS   RE  AO  t   CHECK  TO  SEE   IF   A  COMPLETE  PASS  HAS 

c  HE E  N   MADE    OR    IF    THE   FILE    SHOULD   PE    REWOUND   AND   SEARCHED  AGAIN 

IF  I  I  :r,0)  20.93 
20   R1WIN'-    14  • 

IFIJiNO)  3C.B0 
30   WRIT!    (6,9i0>  PLUNIT 
91C   FORM  ATI *CTHE    PLANNING   UNIT   CARD   ENTITLEO    *6A10/*      INCICATES    THE  EX 
1PANCED  DATA   FILE   JA  S  CREATED  A.'lD  SAVED  ON  AN  OLO  RUN.     HOWEVER,  AS 
?  THE  LIST  BELOW  INDICATES.*/*     NO  SUCH  MLE  EXITS  ON  -SAVOLO-«/) 
IFIL5   =  0 
43  CALL   GGTRFC    (  14  ,  I  D  ,  9  .  I  E  NO  ) 

IFUEND)  70.50 
50   IFILE   =   IFILE   +  1 

WRIT!   (6,920)    IFILE  ,  I  ID1 I ) , 1=1,6) 
920  FORMATI*   SAVOLO  F  I  L  E*  I  3  .  5  X6A10  ) 

C  BYPASS   THE  DATA 

60  CALL   GETREC    (  14  .  BLOCK , 1 88 9 . I  END ) 

IFIIENO)  40,60 
70  WRITS  (6.930) 
930  FORMAT(*0JOB  ABORTED*) 
CALL  ABORT 
8C  JENO   =■  1 

GO  TO  i: 

C  IF   THIS   IS  NOT  THE  DESIRED  FILE,   BYPASS  THE  OATA 

90  DO  IOC   I   =  1,6 

IF(PLUNIT( I  I .NE.  ID(  I  ) )   GO  TO  110 
100  CONTINUE 

GO  TO  120 
110  CALL   GETREC    (  14 , BLOCK ,  1 899, I  END  I 
IF(IENO)  10,110 

C  THIS   IS  THE   FILE.      IF   IT   HAS  THE   SAME  NUMBER  OF  YEARS  AS  IS 

C   CURRENTLY  BEING  PROCESSED,   JUST  COPY  IT  TO  THE  EXPANDED  DATA  FILE 

C   AND  RETURN.     BUT  IF  IT  HAS  A  DIFFERENT  NUMBER  OF  YEARS,   COPY  IT 

C   TO  THE   SCRATCH  FILE  FOR  EXPANSION  OR  CONTRACTION 

120  IFINYEARS  -  ID(7I)  130.140 
130  NRMANG  =  0 
IFILE  =  16 
GO  TO  150 
140  NRMANG  =  2 
IFILF   =  11 
150  REWIND  IFILE 

GO  TO  170 
160  CALL   PUTREC    ( I F I L E , BLOCK , 1 889 ) 
170  CALL   GETREC    I  14 , BLOCK, 1 889 , 1  END  I 

IF(ISNO)  180,160 
180  END   FILE  IFILE 
CALL  CORE  101 

C  RETURN   TO   THE   PRIMARY  OVERLAY 

END 


Program  LOADS 


OVERLAY  (OLAYS.2,0) 
PROGRAM  LOADS 

C  THIS  OVERLAY  CONTAINS  THE  WATER  BALANCE  ANO  UTILITY  ROUTINES  SO 

C   THEY  ARE  AVAILABLE  FOR  EITHER  THE  NORMAL  OR  THE  MANAGEMENT 

C   SIMULATION  AND  IT  CALLS  FOR  THE  LOADING  OF  THE  APPROPRIATE 

C   PERIPHERAL  ROUTINES 

COMMON   DA  TIME (2 )  , OE CMAL . NRMANG, NSAVED, NY E ARS • PLNOPT ( 19 ) , PLUN I T I  6 ) , 
1  RECOVR.REGIONI 81 .REGOPTI 51 , S AVE . SE DRN2 , WE  I GHT 
INTEGER  Da  TIME, PLNOPT, PLUN I T , RECOVR ,REGI ON.REGOPT, SAVE, SE0RN2 
COMMO'J/WTRBAL/ALLOW.ETFROM.EVAPTR.GENPO.  PEAK  ED.  PR  EC  I  P.  RAD  IN. 
1   RADLHN.RAOSWN, TMPM AX, TMPM I N, WATRIN 

COMMON/S/AvSOIL I  11) .OECLINI 1 1 ) , NROADS . R A TNRM ( 111 . ROADMI ( 11), 
1   ROAOWI  11  I  ,  TANCUTI  1  1)  ,  TANFU  I  11  I  ,  T  ANRHO I  1 1  )  ,  YRCNS  Tl  1 1  ) 
INTEGER  YRCNST 

COMMON/ T I ME/CANREF ,CDMAX2 ,CONAV 

COMMON/UTILTY/BLOCKI 1889) , CHANGR . CHANGW , DAT E ( 2  I . DAT E S 1 4 1 , L I  NFS . 
1  NAMc,NDAY,RCHRGO,RO( 3 72  I , WE ( 372  I . WEO . YE AR , YRT OT I  3  I 
INTEGER   DA TF ,OATE S, YEAR 

DIMENSION  6IMNTHI6) , ETC (372 1 , PPT (372 1  , R A0(  372 ) , TMAX (  372 ) , TM 1 N(  372) 
SOU  I  VALENCE   ( BLCCKI 21 , TMAXI 1 ) ) . ( BLOCK  I  374 1  , TM1 N ( 1 1 ) . I  BLOCK! 746) . 

1  PPI 1 1  I  I , (BLOCK ( 1118) .RAD  1 1  I ) , (BLOCK! 14901 . ET3 1 1 ) I , ( BLOCK! 18  641, 

2  CDMAX) . (BLOCK (1665) .VEGTYP)  , ( BLOCK (  1866  I .TRSHLO), I  BLOCK!  18671, 

3  TIP  ML T) . ( BLOCK! 186S) .WILTPT I , (BLOCK! 1871). OCDM AX ) . ( BLOCK (  1872) , 

4  ISGTRMI ,( BLOCK! ie 731 ,P:K DAT) , ( BLOCK (  1 880  I . B I MNTH ( 111, 

5  ( BLOCK! 18861, PEAK WE), (BLOCK (1888) , PE AKRO) 
INTEGER   PcKOAT, VEGTYP 

NROADS  =  C 

N  =  NRMANG 

IFCi.'O.O)  N  =  1 

CALL   OVERLAY  (5HOLAYS,2,N) 

IFIN10ADS..NE.0I   CALL  OVERLAY   ( 5H0L AYS . 2 . 3 ) 
C  RETURN  TO  THE  MAIN  OVERLAY 

r  nd 


Subroutine  WATBAL 


SUBROUTINE  WATBAL  (F1,F2,F3,I1,F4,F5,I2,I3,F6,I4,F7,FR.F9,F1G,F11. 
1   F12.F1-,  ,F14,I5,F15I 

C  THIS   SUBROUTINE    IS  THi   MAIN  ROUTINE   OF   THF   WATER  OALANCE  M006L .  IT 

C   PECEIVES  THE   DRIVING,    STATIC   AND  CONTINUOUS   VARIABLES   FROM  THE 

C   OPERATING  ROUTINES,  CONTROLS  THE  COMPUTATIONS  ON  THEM,  ANO 

C  RETURNS  THE  NEW  VALUES  FT)R  THE  CONTINUOUS  VARIABLES  ANO  THF 

c   RESULTS  CF   THIS   INTERVAL.      SEE   THE   REPLACEMENT   STATEMENTS  BELOW 

c   FOR   THE  VARIABLE  DEFINITIONS  OF  THE  PARAMETERS 


COMMON /ONLYCR/    AVETMC .BASTHF ,C ALOF , CDMAX , COV DN . ORE OY , ENGBL . 

1  FNGBLO.FIFLOC . FRF WT , L SUSP . NDSNO , ONTR E , PHAS E , PREWE, 

2  PChRG.SMTMl 13) , SMTM3 , TCOE F , TMPMLT , TR SHL C, VEGTYP 
INTEGER   OREDY, PHASE, VEGTY= 

COMMON /WTO BAL /ALLOW, E TF ROM, FVAPTR.GENRO, PEAK  ED, PREC IP, RAD  IN, 
1    RAI5LXN|R  AOSWN,  TMPM AX, TMPM I  N, WATRIN 
DATA   AV : TVC. BASTMF, ENGBL. SMTM3/ 0.0. 35. 0.-1.0,0.0/ 

C  OBTAIN  THE   STATION  DESCRIPTORS 

COVDV  =  T3 
CDMAX  -  XI 
FIECDC  *  -F15 
TCOE F  »  F12 
TMPMLT  -  rl3 
TRSHLD  =  F14 
VEGTY"  =  15 

C  RECALL  THE  CONTINUOUS  VARIABLES  NECESSARY  FOR  THE  OPERATION  OF  THE 

C   MODEL  DURING  THIS  INTERVAL 

CALOF  =  F! 

DRFDY   =  II 

ENGHLO    =  F4 

FREWT    =  F5 

LSUSO  =  12 

NDSSO  =   13  ♦  1 

ONTFc    =  F6 

PHASE    =  14 

PREWE   =  F7 

RCHRG  ■  F8 

IFID'iEDYl  20,20,10 
10  SMTHI11)   -  ft 

SMTM1I2)   =  F10 

SHTMH3I   =  Fll 

C  AVETMC  =   (  (  (TMPMAX-32IMTMPMIN-32)  l/2)»(  5/9) 

20  AVETMC  =   ( TMPMAX  ♦  TMPM I N  -  64.0)  •  0.2777777778 
C  START  THE  ENERGY  BALANCE  AND  THE  INPUT  AT  ZERO  FOR  THIS  INTERVAL 

ENGBL  *  0.0 

WATRIN  =■  0.0 

C  IF  THERE   IS  NO  PR6CIP,   THERE   IS  NO  NEED  TO  PASS  THROUGH  THE 

C   CLASSIFICATION  STATEMENTS 

IFIPRECIPI  90,90,30 

C  SEE   IF   THE  PREC1P  IS  ALL  SNOW 

30   IF! TMPMIN.LE. 32.0. OR.TMPMAX.LT. BASTMF I  GO  TO  80 

C  SEE   IF  ANY  OF  IT  IS  SNOW 

IF! TMPM I N  -  BASTMF)  40,50.50 
40  CALL  MIXTUR 
GO  TO  90 

C  THIS   IS  A  RAIN  EVENT.     IF  THERE   IS  NO  PACK,   THE  RAIN  IS  DIRECT 

C   INPUT  TO  THE  WATER  BALANCE.     BUT   IF  THERE   IS  A  PACK,  OETERMINE 

C   THE   EFFECTS  OF  THE  RAIN 

50   IFIPREWSI  6C60.70 

60  WATRIN  *  PRECIP 
GO  TO  13C 

70  CALL  RAINED   ( AVETMC .PREC 1 P I 
GO  TO  90 
C  THIS   IS  A  SNOW  EVENT 

BO  CALL   SNOWED    I  AMI Nl    1 AVETMC ,0 .0  I . PR  EC  I P I 

c  if  there  is  snow  on  the  trees,  evaporate  only  from  the  canopy 

90  IFIONTRE)  130.130.100 
100  CALL  CANVAP 

C  ON  THE  FIRST  DAY  AFTER  FRESH  SNOW.   ASSUME  TURBULENCE  HAS  REMOVED 

C   ANY  REMAINING  INTERCEPTED  SNOW  ANO  ADDED  IT  TO  THE  PACK 

IFINOSNO  -  II  12C.113.110 
110  PREWE  =  PREWE  *  ONTRE 

ONTRE  '  -3.0 

C  IF   THERE   IS  NO  SNOWPACK,  BYPASS  THE  RADIATION  ROUTINES 

120  IF(PREW<=>  190,190.180 

C  OETERMINE  THE  FOREST  TYPE  -  CONIFEROUS  OR  DECIDUOUS 

130  IFIVEGTYP.NE. 3. ANO. VEGTYP. NE .4)  GO  TO  135 

C  DECIDUOUS 

CALL  D?CIP 
GO  TO  20C 

c  CONIFEROUS  -  DETERMINE  WHETHER  TO  SATISFY  THE  EVAPOTRANSPIRATION 

C   REQUIREMENTS  UNDER  GROWING  SEASON  OR  WINTER  CONDITIONS 

135  IFIPRFWEI  160,160.140 

140  IFtPREWE  -  5.01  150.15C.170 
C  USE   THE  GROWING  SEASON  ROUTINES  TO  INCLUOE  TRANSPIRATION 

150  CALl  RADBAL 

C  ADD  -WATRIN-  TO  THE  RECHARGE  REQUIREMENTS  SO  THE  ET  ROUTINE  CAN 

C   OPERATC  ON  THE  INPUT  AS  WELL  AS  THE  STORAGE 

160  RCHRG  *  RCHRG  ♦  WATRIN 

C  0.22388  >  3.15/C.67   (SEE  THE  COMMENT   IN  SUBROUTINE  EVTRAN  FOR  THE 

c  USE  OF   THE  CONSTANT) 

CALL  EVTRAN  10.223881 

GO  TO  20C 

C  USE   THE  WINTER  ROUTINES  TO  EVAPORATE  FROM  THE  SNOWPACK  SURFACE 

17?  CALL  S'lOVAP 
18C  CALL  RADBAL 

C  ADO  -WATRIN-  TO  THE  R c CHARGE ' REQUI REME NT S 

19C  RCHRG   =  RCHRG  ♦  WATRIN 

C  IF  THE  RECHARGE  REQUIREMENTS  WERE  SATISFIEO.   THE  EXCESS  IS 

C   CONSIDERED  TO  BE  GENERATED  RUNOFF 

200   IF(BCHRG)  220.22C.213 
21C  GENRO  =  RCHRG 
F8  =  0.0 
GO  TO  230 
220  G'NRO  =  0.0 
F8  =  RCHRG 

230  ii  =  na;r>Y 

Fl  --  CALDF 
F4  =  ENGBL 
F5  =  FRSWT 

12  =  LSUSO 

13  =  NOSNP 
F6  =  ONTRF 
F7   =  PRSWE 

C  WH<=N  TH"  PACK   IS  GONE,   RsSET  THE   PHASE  INDICATOR 

IFIPFFWS)  240,240,250 
243  14   =  0 

RETURN 
250    14    -  PHASF 

IF(DRCOY)  270,270,260 
260   F9    =    SVTM1 | 1 | 

F10  =  SYT"1(2| 

Fll   =  SMTM1I3I 
27C  rctusi; 

END 
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Subroutine  CALIN 

SURC-UTr\=   CUIl  (CALRT1I 

C  THIS    SLHiruTIMS    COMPUTES    THE    EFFECTS    OF    THE   CALORIC    INPUT   ON  THE 

c  SNOWPACK 

CCKHtlN/ONLVCR/  AV'H'C  BASTMF  ,CA LOF  .CDMAX  .COVON .  ORE  DY  .  ENGBL  . 

1  E'JGHL  "  .FlrLDCFREWT.LSUSD  . NDSNO » ONTRE  .  PHASE  » PREME, 

2  PCIIPG.  5HTH!  13)  , S"TMJ ,  TCOEF  , T MPMLT , T RSHL D. V EGT YP 

QSCDY, PHASE, VEGTYP 
dlMMON/  JT^BAL  /ALLOW,  ETFROM, EVAPTR  ,GENRO.  PF  AXED.  PREC  I  P.RAOIN. 
1    R  ALL  «N  .RADSWN  , TMPMAX, TMPMI N .WATRIN 

C  AOr    THESE   CALORIES    I  NTO   THE   ENERGY  BALANCE 

Enopl  =  ENGOl  ♦  CALRIN 

C  SEE   IF  A  CALORIE  DEFICIT  EXISTS  IN  THE  PACK 

COMPAR    =   CALRIN   -   C  A  LOF 
IF(CO"P\RI  13,2l',30 

C  THE--   IS  A  CALORIE  OEFICIT,   flUT  THE   INPUT  OIO  NOT  COMPLETELY 

C  IK;    IT   "UT.      ALL   OTHER   CONDITIONS    ARE  UNCHANGED 

1C  CALOF   *  -  COMPAR 
RETURN 

C  THE  CALORIE  OEFICIT  WAS  Ml  PEO  OUT,   BUT  ALL  OTHER  CONDITIONS  ARE 

C  UNCHANGED 

23  CALCF  =  CO 
RETUR*. 

C  ANY  OEFICIT  MHICH  OIO  EXIST  MAS  MIPED  OUT.     COMPUTE  THE  POTENTIAL 

C   PELT  FROM  THE  REMAINING  CALORIES   ( CALOR I ES/ ( SO .0  •  2.5*11 

3C  POTPLT  -  rOMPAR/2G3.2 
CALUF  »  0.0 

C  IF   THC   INPUT  MAS  ENOUGH  TO  MELT  THE  WHOLE  PACK ,  CONTRIBUTE  THE 

C   WATER  EOUI VALENT  TO  THE   SNOWMELT  AND  ZERO  ALL  CONDITIONS 

IFIPOTMLr.LT. PRE ME-FREHTI   GO  TC  40 

MATRIN    ■   WATRIN   ♦  PREWE 

PR  CM  r  «  G.O 

FREWT  *  O.G 

RE  TURN 

C  DEPLETE  THE   ICE  PACK  BY  THE  AMOUNT  MELTED  AND  CONTRIBUTE  THAT 

C   AMOUNT  TO  THE  FREE  MATER 

40  FREMT  =  Fc  EMT  ♦  POTMLT 

C  COMPUTE    THE   NEM   HOLDING   CAPACITY   OF    THE    PACK    ANO  COMPARE    IT  WITH 

C   THE  FREE  WATER  TO  SEE   IF  SNOMMELT   IS  PRODUCED 

HOLDCP    =   0.0*   *    I PREME    -  FREMT) 

COMPAR   *  FREMT  -  HOLDCP 

IFICOMPAR.LE.O.O)  RETURN 

C  THE   SNOMMELT  CONTRIBUTED  IS  IN  -COMPAR-.     REDUCE  THE  FREE  MATER 

C   TO  LEAVE  A  PRIMED  PACK  ANO  REOUCE  THE  PREDICTEO  MATER  EQUIVALENT 

PREME  =  PREWE  -  COMPAR 

MATRIN  »   WATRIN   »  COMPAR 

FREWT  =  HOLDCP 

RETURN 

ENO 


Subroutine  CALOSS 


SUBROUTINE  CALOSS  ICALOUTI 

C  THIS  SUBROUTINE  COMPUTES  THE  EFFECTS  OF  THE  CALORIC  LOSS  ON  THE 

C   SNOWPACK 

COMMON /ONLYCR/  AVETHC.BASTMF, CALOF, CDMAX.COVON.DREDY.ENGSL. 

1  ENGBLO.  F I  ELDCFREMT.LSUSD.NDSNO.ONTRE. PHASE, PREME, 

2  RCHRG.SMTMl 131 ,SMTM3,TC0EF , TMPMLT , TRSHLO.VEGTYP 
INTEGER  DREDY, PHASE, VEGTYP 

C0MMnN/MTRBAL/ALL0M,ETF ROM, EVAPTR, GENRO,PEAKEO,PRECIP,RADIN« 
1   RADLMN,RADSMN,TMPMAX,TMPM IN, MATRIN 
C  ADD  ALGEBRAICALLY  THESE  CALORIES  INTO  THE  ENERGY  BALANCE 

ENGBL   =  ENGBL  ♦  CALOUT 

C  SEE   IF   THERE   IS  ANY  FREE  MATER  IN  THE  PACK.     IF  NOT,   THE  LOSS  IS 

C   JUST  CONTRIBUTED  TO  THE  CALORIC  OEFICIT  OF  THE  SNOMPACK. 

C   REMEMBER  THAT  -CALOUT-  IS  NEGATIVE 

IFIFREWT.GT.O.O)  GO  TO  10 

CALOF   =  CALOF  -  CALOUT 

RETURN 

C  COMPUTE  THE  CALORIC  LOSS  NECESSARY  TO  FREEZE  ALL  OF  THE  FREE  MATER 

C   (FREE  MATER  *  80.0  •  2.5*1 

10  CALNED  '=  FREMT  •  203.2 

C  NOM  COMPARE  THAT  NECESSARY  LOSS  MITH  THE  ACTUAL  LOSS.     IF  THEY  ARE 

C   THE   SAME,   THE  FREE  MATER   IS  WIPED  OUT  BUT  NO  OTHER  CONDITIONS  ARE 

C   ALTERED 

COMPAR   =  CALOUT  ♦  CALNEO 
IFICOMPAR)  20,30,*0 

C  THE  LOSS  MAS  MORE  THAN  ENOUGH  TO  FREEZE   IT.     THE  BALANCE  CREATES 

C   AN  ENERGY  OEFICIT  IN  THE   PACK  AND  THE  FREE  MATER  IS  MIPEO  OUT 

20  CALOF   =  -  COMPAR 
30  FREWT  =  0.0 
RETURN 

C  ONLY  PART  OF   THE  FREE  MATER  FROZE.     COMPUTE  THE  BALANCE  REMAINING 

C   BALANCE   =  EXISTING  FREE  MATER  -  AMOUNT  FROZEN,  WHERE 

C  AMOUNT  FROZEN  »  CALOR I ES/ I  80 .0  •  2.5*1 

*0  FREWT   =  FREMT  ♦   ( C ALOUT/203 . 2 1 

RETURN 

ENO 


Subroutine  CANVAP 


SUBROUTINE  CANVAP 

C  COMPUTE  THE  EVAPORATION  FROM  THE   INTERCEPTED  SNOM  AS  A  FUNCTION  OF 

C   THE  CANOPY  COVER  DENSITY.     NOTE  -  THIS  VERSION  REPLACED  THE 

c   ORIGINAL  SUBROUTINE  CANVAP  IN  DECE»BFR,   1973,   TO  INCORPORATE  THE 

C   Tt»c   TRENDS  OF  REGROWTH 

COMXON/ONLYCR/  AVETfC .BASTMF , CALOF ,CDMAX , COVON , OREOY , ENGBL ■ 

1  ENGBLO, F  I  ELDCFREMT.LSUSD.NDSNO.ONTRE,  PHASE,  PREME, 

2  R.CH8G  •  SMTM1  ( 3 )  , SMTM3, TCOEF , TMPMLT . TRSHLO, VEGTYP 
INTEGER  DREDY, PHASE , VEGTYP 

COMMOI/WTRBAL/ALLOW.ETFROM, EVAPTR, GENRO, PEAKED, PREC IP.RAOIN, 
1    34r>LWN,CADSWN,TMPMAX,TMPMIN,  WATRIN 
COMMON/ TI"fi/CANREF,CDMAX2,  CON AV 

C  IF   TIIF  COVER   DENSITY   IS  GREATER   THAN  OR   EOUAL   TO  HALF  OF  THF 

C   MAXIMUM  COVER  DENSITY   (ASSUMES  COMPLETE  OR  NEARLY  COMPLETE 

C  CPOn'i  COVER   AT  CDMAX/2),   EVAPORATE  ONLY  FROM  THE  CANOPY 

IFICDMAX2   -  COVGNI    10. 10.40 
I'.   ETFtOM   =  i.? 


EVAPTR    »  EVAPTR/CDVDN 

ONTR "    >   ONTRE    -  EVAPTR 

IFIONTR- I  20,30,3; 
20  EVAPTR    =   ONTR?    ♦  3VAPTR 

ONTPC    "  0.0 
30  RETURN 

C  EVAPORATE   FROM   THE   SNOWPACK    SURFACE    (USING   THE   PROCEOURES  OF 

C   SUBROUTINE    SNOVAP)    AND   FROM   THE    CANOPY,    COMBINING   THE   RESULTS  AS 

C   A  FUNCTION  OF   THE   PRESENT  PERCENTAGE  OF  CROWN  COVEP 

*C  CTFPOM   »  3.0 

PRCNTC    =   CO VON/C  DM A  X2 

E  T  S    ■   1(1.0  -  COVONI   •   EVAPTR I    •   (1.0  -  PRCNTC) 

iFiPREw-  -  :ts)  5;,50,60 

50  FTS  =  PkEWE 

pre*:  =  :.3 

GO  TC  7: 
60  PREWE  =  PREWE  -  ETS 
70  ETC    =■   (EVAPTR/COVONI   «  PRCNTC 

ONTRF   =  ONTRE  -  ETC 

IF (ONTRE)  90,90,90 
BO  FTC   =■  ONTRE  ♦  ETC 

ONTRE   »  C.C 
90  EVAPTR   =  ETC  ♦  ETS 

RETURN 

END 


Subroutine  DECID 


SUBROUTINE  DECIO 

C  OECIDUOUS  FOREST  -  DETERMINE  THE  SOURCE  OF  THE  EVAPOTRANSP IRAT ION 

COMMON/ONI YCR/  AVET MC, BASTMF, CAL OF, CDMAX, COVON, ORE DY, ENGBL, 

1  ENO  BL  O.F  I  ELOCFREWT.LSUSO.NOSNO,  ONTRF,  PHASE,  PREWE, 

2  RCHRCSMTMK  3  ) ,  SMTM3,  TCOEF ,  TMPMLT,  TRSHLO.VEGTYP 
INTEGER  DREDY, PHASE .VEGTYP 

COMMON / WTR OAL /A L LOW, ETFROM, EVAPTR, GENRO, PEAKED, PREC I P, RAD  IN, 
1   RADLWN,RADSWN,TMPMAX,TMPMIN, WATRIN 

C  IF  FOLIAGE    IS  PRESENT,   USE   EVAP0TRANSP1R AT  I  ON 

I F I VEGTYP  -  3)  *0,10 

c  IF  THERE   IS  NO  PACK,  BYPASS  THE  RAOIATICN  ROUTINES 

10  IF(PREWE)  20,30 
20  CALL  RAOBAL 

C  ADD  -WATRIN-  TO  THE  RECHARGE  REQUIREMENTS  SO  THE  ET  ROUTINE  CAN 

C   OPERATE  ON   THE   INPUT   AS   WELL  AS   THE  STORAGE 

30  RCHPG  =  RCHRG  ♦  MATRIN 

C  0.1*92*  =  0.10/0.67   (SEE  THE  COMMENT  IN  SUBROUTINE  EVTRAN  FOR  THE 

C  USE  OF   THE  CONSTANT) 

CALL  EVTRAN  (0.1*925) 

RETURN 

C  SINCE  FOLIAGE   IS  NOT  PRESENT ,  EVAPORATE  FROM  THE  PACK  SURFACE   IF  A 

C  PACK  EXISTS 

*C  IF (PREME )  50,60 

50  CALL  SNOVAP 
CALL  RADBAL 

C  AOO  -WATRIN-   TO  THE   RECHARGE  REQUIREMENTS 

RCHPG   -  RCHRG  ♦  WATRIN 
RETURN 

C  NEITHER  FOLIAGE  NOR  PACK  ARE  PRESENT.     AOJUST  THE  EVAPORATION  FOR 

C   AVAILABLE   SOIL  WATER  BY  THE  SAME  RELATIONSHIP  USED   IN  EVTRAN  FOR 

C   OPENINGS,   THEN  ADJUST  FOR  COVER  DENSITY  AS   IN  SNOWVAP   (USE  ANY 

C   INPUT  TO  HELP  SATISFY  THE  REQUIREMENTS) 

60  ETFRUM  =  *.0 

RCHRG  =  RCHRG  ♦  WATRIN 
I F I RCHRG  f   (FIELDC/*.OI I  70,70,80 
70  EVAPTR  =  O.C 
RETURN 

80  AVABLE   =  ( ( *.0/F I ELDC I   «   (FIELOC  ♦  RCHRG))  -  3.0 

EVAPTR  =  EVAPTR  *  AVABLE  «   (1.0  -  COVON) 

IFUCHRG  -  EVAPTR  ♦  F I  ELDC )  90,100,100 
90  EVAPTR   =  RCHRG  ♦  FIELOC 

RCHRG   =  -  FIELOC 

RETURN 

100  RCHRG  =  RCHRG  -  EVAPTR 
RETURN 
END 


Subroutine  DIFMOD 


SUBROUTINE  DIFMOD 

C  THIS  SUBROUTINE  WAS  DERIVED  FROM  PROGRAM  SMTM.   A  SNOWPACK 

C   TEMPERATURE  DIFFUSION  MODEL  DEVELOPED  BY  LEAF   (1970  STUDY  PLAN 

C   FS-RM-1602,   NO.   22*,  RMFtRES).     USING  THE  AVERAGE  SURFACE  TEMP 

C   AND  THE  GROUND  TEMP  AS  BOUNDARY  CONDITIONS,   THE  NEW  AVERAGE 

C   SNOMPACK  TEMPERATURE   IS  CALCULATED 

COMMON/ ONL  YCR /   AVET MC BASTMF, CAL DF, CDMAX, COVON, DREDY, ENGBL, 

1  ENGBLO,  F  I  ELDCFREMT.LSUSD.NDSNO.ONTRE,  PHASE,  PREME, 

2  RCHRG, SMTMK 31 .SMTH3, TCOEF , TMPMLT .TRSHLO.VEGTYP 
INTEGER  DREDY, PHASE, VEGTYP 

COMM0N/MTRBAL/ALL0M,ETFROM,EVAPTR,GENRO, PEAKED, PREC I P.RADIN, 
1   RACLMNiR SDSWN, TMPMAX, TMPMI N, MATRIN 

C  COMPUTE   THE  DENSITY  OF    THE   SNOMPACK   (THE   FUNCTION  MAS   DERIVED  FROM 

C   OOSERVED  CONDITIONS  ON  THE  FRASER  EXPERIMENTAL  FOREST) 

OENSTY  =   (EXPII0.0179  »  PREWE)   ♦  3.02)1/100.0 

C  COMPUTE  THE  DISTANCE  BETWEEN  THE  TWO  NODES  IN  CENTIMETERS 

C  DEPTH  =  PREWE  /OENSTY 

C  H  •  (OEPTH/2)»2.54 

H   =    (PREWE/DENSTY)    •  1.27 

C  THE   THERMAL   OIFFUSIVITY   IS  CALCULATED  FROM  THE  FUNCTION 

C  KV  =  0.C1/II2.751  -  OENSTY )  *  0.*8).     MATHEMATICAL  STABILITY 

C   REQUIRES    THAT    THE    VALUE    OF    THE    QUANTITY    ( INTERVAL    IN    SECONOS  * 

C   KV/H»»2)   BE   LESS  THAN  0.5.     WHEN  A   2*  HOUR    I NTFRVAL    IS   USED,  THE 

C   SNOW  OF°TH  MUST  EXCEFO  30   INCHES   (20  PERCENT  DENSITY)  TO  ACHIEVE 

C   STABILITY.      IN  ORDER   TO  INSURE   STABILITY  MITH  SOMEWHAT  SHALLOHER 

C   PACKS    ( ABOUT    18    INCHES).    THE   OAY    IS    DIVIDED    INTO   2    TIME  INTERVALS 

c          rr  iz  hours  (43200  seconds) 

C  CCNST1   =  (43200  «  0.01/(12.751  -  OENSTY)   «  0.4B))/H*»2 

C0NST1    =  900. :/( 12.751   -  DE NSTY I *H*H ) 

C  THE    MINIMUM   WATER    EQUIVALENT    MHICH  MILL    ACHIEVE    STABILITY  USING 

C  THE    ABOVE    DENSITY   FUNCTION    IS   4.7  INCHES 

IFICOA'STl  -  0.51  20,10.10 
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c  THE    "CDEL    IS   UNSTABLE    -    IWICATE    THAT    IT    IS    NOT    READY    FOR    USE   NOW  • 

C   (IT    MAY    "6    INITIALIZED    A"-,AIN   BY    AN  OBSERVEO   PACK    TEMPERATURE  CARD 

C   AND   STABILITY  WILL   BE   ASCERTAINED  FROM   THE  WATER  EQUIVALENT  AT 

C   T  H  ft  T  TIME) 

iO  D°EUV   =  3 
R'TUPN 

C  G:t  THE   SECOND  CONSTANT 

2C  CONST2  =  1.0  -  CONST1  -  CONST1 

C  PERFORM   THE   SIMULATION   IN   TWO  PARTS   (ONE  FOR   EACH   12   HOUR  PERIOD). 

C   -SKTvl-  HOLDS   THE   THREE   TEMPERATURES   FROM  THE   PREVIOUS  INTERVAL 

C   THAT    ARE   NFFDED    TO   SIMULATE    SMTM2,    THE    NODE    AT    THE   CENTER  OF 

C   THE   PACK.      SIMULATE   THE   FIRST   12  HOURS  NOW 

SMTK?  =   (CONST1   »  (SMTMK1)   ♦  SMTM1 1 3  J ) I   »   ( CONST2  «  SMTM1 
II  2)  I 

C  THE   AVERAGE   SNOWPACK  TEMPERATURE   IS  THE   AVERAGE  OF  THE  2  NOOES 

C   (KIDDLE   AND  GROUND)    IN  BOTH   INTERVALS.     GROUND  TEMPERATURE  IS 

C   CONSTANT,    SO    START    THE    AVERAGE  NOW 

SMTM3   =   SMTM1 ( 3 )    *   SMTH1 (31    ♦  SMTM2 

C  RESET   -SMTM1-    TO   THE    TEMPERATURES   OF   THE    INTERVAL   JUST  SIMULATED 

C   FOR    USE    IN    THE    SCCOND    12    HOUR    INTERVAL    SIMULATION.      THE  SURFACE 

C   ai3   TEMPERATURE   IS  SPLIT  INTO  A  LOW  AVERAGE   I    (MEAN+MINI/2   )  AND 

C   A   HIGH   AVERAGE    I    I ME  AN*  MA  X ) /2    )    FOR   USE   WITH   THE   TWELVE  HOUR 

C   INTERVALS.     USE  THE  LOW  AVERAGE  NOW 

S  M  T  M 1 ( 1 )   =  AMIN1   (0.0, ((( TMPMIN-32.0) *0 .  5555 5 5 5 5 56  I  ♦  AVE  T MC  )  / 
1  2.0 ) 

SHTH1I2)   =  SMTM2 

C  SIMULATE    THE    SECOND    12    HOURS    AND   COMPUTE    THE    AVERAGE  SNOWPACK 

c   TEMPERATURE 

SMTM2  =   (C0NST1  «   (SMTMK1)   *  SMTMK3)))   ♦   t  C0NST2  «  SMTM1 
112)) 

SMTM3    =    (SMTM3   ♦  SMTM21/4.0 

C  RESET  -SMTM1-  USING  THE  HIGH  AVERAGE  FOR  USE  ON  THE  FIRST 

C   INTERVAL   OF   THE   NEXT  DAY 

SMTMllll   =  AMIN1    (CO  »  (  (  (TMPMAX-32.0)  *0.  5555555556  I  ♦  AVE  TMC  )/ 
1  2.0) 
SMTMK2I   =  SMTM2 

C  CHECK  TO  SEE   IF  THE  GROUND  TEMPERATURE  SHOULD  BE  RAISED 

IFISMTM3  *  1.5)  60,40,30 
30  IFISMTM3  ♦  0.5)  40,50,50 
40  IFI  SMTM1 1  3)  .LT.-0.5)   SMTMK3)  =  -0.5 

RETURN 
50  SMTM 1(3)  =  o.: 
60  RETURN 
ENO 


Subroutine  EVTRAN 


SUBROUTINE  EVTRAN 

C  COMPUTE   THE   EVAPORATION  AND  TRANSPIRATION  DURING  THE  GROWING 

C   SEASON.     NOTE  -  THIS  VERSION  REPLACED  THE  ORIGINAL  SUBROUTINE 

C   EVTRAN  IN  OECEMBER,  1973,  TO  INCORPORATE  THE  TIME  TRENDS  OF 

C-   REGROwTH 

COMMON /ONL YCR /  AVETMC , BAS IMF , C ALDF , CDMAX ,COVDN , DREDY , ENGBL , 

1  ENGBLO,FI£LDC , F RE WT , LSUSD , NDSNO ,ONTRE , PHASE, PR EWE, 

2  RCHRG , SMTM1 13) ,SMTM3,TCOEF,TMPMLT,TRSHL0,VEGTYP 
INTEGER  DREDY, PHASE, VEGTYP 

COMMON/ WTRBAL /ALLOW, E TFROM , E VAPTR .GENRO, PEAK  ED, PREC I P.RADIN, 
1  RADLWN,RADSWN,TMPHAX,TMPMIN,WATRIN 
COMMON/ TIME/CANREF,C0MAX2,C0NAV 
ETFROM  =  4.0 

C  GET  THE  ADJUSTMENT  FACTOR  FOR  AVAILABLE  SOIL  WATER 

C  AVABLE  -  4»EXP(-K«(T-TC))«(BETA/H  -  EXP( -K« I T-TC ) I  +  1.0,  WHEN 

C   T   (YEARS  SINCE  TREATMENT)    IS  GREATER  THAN  OR  EQUAL  TO  TC  (BASE 

C   YEAR  OF  FUNCTION).     THE  CONSTANT  K  IS  CALCULATED  WHEN  THE 

C   MANAGEMENT  PLAN  CARD   IS  READ,   AND   THE  CONSTANT  -CONAV-  IS 

C   COMPUTEO  AT  THE   BEGINNING  OF  EACH  WATER  YEAR   BY  THE  TIME  TRENDS 

C   ROUTINE.     BETA   IS  THE  AVAILABLE  WATER 

AVABLE  =   ( 4.0*CONAV* ( ( ( RCHRG+F I ELDC ) /F I E LDC ) -CONAV ) )   ♦  1.0 

I F { AVABLE )  10,10,20 

C  THE   WILTING  POINT  HAS  BEEN  REACHED 

10  EVAPTR  =  0.0 

RETURN 

20  IFI 1 .C  -  AVABLE I  30,40,40 

C  THE   FACTOR    IS  MAXIMIZEO 

30  AVABLE   =  1.0 

C  THE   ADJUSTMENT  FOR  CANOPY  REFLECTIVITY  IS  RECOMPUTED  EACH  YEAR. 

C   PERFORM  THE  ADJUSTMENTS  NOW 

40  EVAPTR   =  EVAPTR  »  AVABLE   •  CANREF 

C  IF   THE  EVAPOTRANSPIRATION  WILL   DEPLETE   THE  MANTLE   STORAGE  BELOW 

C   THE  WILTING  POINT,  ALTER  THE  EVAPOTRANSPIRATION 

IFIRCHRG  -   EVAPTR  »  FIELDC)  50,60,60 
50  EVAPTR   =  RCHRG  ♦  FIELDC 
RCHRG  =  -  FIELDC 
RETURN 

60  RCHRG  =  RCHRG  -  EVAPTR 
RETURN 
END 


Subroutine  LINK 


SUBROUTINE  LINK   (CALAIR.CALRIE, IRETRN) 

C  THIS   SUBROUTINE   IS   THE    INTERFACE   BETWEEN  THE  RAO  I  AT  1  ON  BALANCE 

C   (SUBROUTINE  RADBAL)   AND  THE  DIFFUSION  MODEL   (SUBROUTINE  nlFMOOl 

COMMON/ ONL YCR/   AVET MC.B AST MF.CALOF, CDMAX, COVDN, DREDY, ENGBL, 

1  ENGBL'.'  .FIELDC,  FREWT  ,L  SUSO ,  NDSNO,  ONTRE  .PHASE  ,  PR  EWE , 

2  RCHRG, SMTM II 31 , SMTM 3 , TCOEF , TMPMLT . TRSHLO, VEGTYP 
INTEGER   DREDY, PHASE .VEGTYP 

COMMON/ WTRBAL /ALLOW, ETFROM, EVAPTR, GENRO, PE AK ED, PREC I P , R AD  IN , 
1   RAOLWN.RADSWN.TMPMAX, TMPM I N , WATR 1 N 

C  SEE    IF    THE    RADIATION   BALANCE    IS    AN   ENERGY   LOSS    OR  GAIN 

IF(CALPIE)  10,10,80 

C  THERE  WAS  A  LOSS.     IF  THIS   IS  STILL  WINTER   (NO  FREE  WATER),  JUST 

C   GO    AHEAO   AND  USE    THE    DIFFUSION  MODEL 

10  IF ( FRF WT )  23,20,50 

C  USE    THE   DIFFUSIJN  MODEL   TO  SIMULATE  THE   CURRENT   AVERAGE  SNOWPACK 

[  TEMPERATURE 

2C  I F( DRFDY.NE . 1 )  GO  TO  140 
CALL  TIFMOO 
IFintEDY)  40.40,30 
C  NOW   MAKE   ANY  NECESSARY   ADJUSTMENTS    IN  THE  RADIATION  BALANCE  TO 


C   CAUSE    THE    PACK    TEMPERATURE    TO   BE   THE    SAME    AS   -SHTM3-.    GET  THE 

C   D I FFERENC E   BETWEEN   THE  CALORIE   DEFICITS   AS   COMPUTEO  BY  THE 

C  OITFFSENT   ME  THUD  S 

30  CALO!J   =  CALDF   *    (  SHTM3   «  PREWE  «  1.271 

C  ADJUST    THE    LONG   WAVE    PORTION   OF    THE    RADIATION    BALANCE    BY  THE 

C   DIFFERENCE  BETWEEN  THE  CALORIES  DERIVED  FROM  THE  DIFFUSION  MOOEL 

C   AND   THE  ENERGY  BALANCE 

CALRIE   =  CALOM 

RADLWN   =  CALRIE   -  RADSWN 
40   IRETPN   =  C 

RETURN 

C  THE  LOSS  IS  USED  TO  FREEZE   PART  OR  ALL  OF  THE  FREE  WATER,   BUT  IT 

C   MAY  NOT  CREATE  COLO  CONTENT.      IF   IT  WOULD  CREATE  CULD  CONTENT, 

C  PC-INITIALIZE   THE  DIFFUSION  MOOEL  TO  0  AND  ADJUST  THE  ENERGY 

C  BALANCE  ACCORDINGLY 

50  CALL  CSLOSS   (CALRIE I 

IFIFREWT  -  0.05)  60,60,70 
60  SMTMllll   =  AMI Nl    (AVETMC, 0.0) 

S»TMl(2l   =  0.0 

SMTM I | 3 )   =  0.0 

DREDY   =  I 

C  MAKE    ANY   NECESSARY   ADJUSTMENTS   TO  THE    ENERGY    BALANCE    TO  COMPENSATE 

C   FOR  THE  COLO  CONTENT  THAT  WOULO  HAVE  BEEN  GENERATEO  BY  THIS  LOSS 

C   AND   ZERO   THE   COLD  CONTENT 

ENGBL  =  ENGBL  ♦  CALDF 

RADLWN  =  RADLWN  ♦  CALDF 

FREWT   =  0.0 

CALDF   =  0.0 
70   IRETRN   =  1 

RETURN 

C  THERE  IS  CALORIC   INPUT  TO  THE  PACK.     CHECK  TO  SEE  IF  CONDITIONS 

t   INDICATE  THAT  THE  DIFFUSION  MODEL  SHOULD  BE  TURNED  OFF  AND  THE 

C   ENERGY  BALANCE  USED  FOR  SPRINGTIME  SIMULATION.     CONSIDER  FIRST 

c   ANY  COLD  CONTENT   (INCLUDING  THAT   OF  THE   PREVIOUS  DAY  AND  ANY 

C   CREATED  BY  A  SNOW  EVENT  ON  THIS  DAY).     IF  THERE   IS  COLD  CONTENT, 

C   CHECK   THF  AVERAGE  AIR   TEMPERATURE  AND  THE  SNOWPACK  TEMPERATURE 

C   FROM  THE  PREVIOUS  DAY  FOR  ARBITRARILY  CHOSEN  SPRINGTIME 

C   CONDITIONS  AND  IF  ALL  ARE  NOT  SATISFIED,  GO  AHEAD  AND  USE  THE 

C  DIFFUSION  MOOEL 

80   IF(CALOF)  170,170,90 
C  0.889  =  1.27  *  0.7  DEGREES  C   (ARBITRARY  TEMPI 

90  IF  I AVETMC.LE.O.:. OR. CALDF. GT.PREWE«0. 889)  GO  TO  20 

C  SINCE  SPRINGTIME  CONDITIONS  PREVAIL,  RECOMPUTE  THE  BACK  RADIATION 

C  JNIO   THE  NET  RADIATION   BALANCE    (  REMEMBER ,   IF  THERE   IS   SNOW,  THE 

c   LONGWAVE   IS  ASSUMED  TO  BE   ZERO,  SO  THERE  WOULD  BE  NO  NEED  TO  MAKE 

C  ANY  ADJUSTMENTS  > 

1FINDSN0I  140,140,100 
100  USE   =   (TMPMIN  -  32.0)   *  0.5555555556 
IF(USE.GT.O.O)   USE  =  0.0 

CALSNO  =   1.17E-7   •   ((USE  ♦   273.16)    ««  4) 
IF(PRECIP)  110.110.120 
110  RADLWN   =   1(1.0  -  COVON )   »   (10.757  »  CALAIR)   -  CALSNO))   *  ICOVON 
1   «   (CALAIR   -  CALSNO)) 
GO  TO  130 
120  RADLWN   =  CALAIR   -  CALSNO 
130  CALRIE   =  RADSWN  ♦  RADLWN 

C  RE-INITIALIZE   THE  DIFFUSION  MODEL   TO  THESE  CONDITIONS   I  BUT   IF  THE 

C   INPUT   IS  MORE    THAN  ENOUGH   TO  WIPE   OUT  THE  CALORIE  DEFICIT,  JUST 

C   LET   IT  BRING  THE  PACK  TO  ISOTHERMAL.     IN  THIS  WAY,   TWO  CONSECU- 

C   TIVE  DAYS  OF   INPUT  ARE  REQUIRED  TO  GENERATE  FREE  WATER) 

140  COMPAR   =  CALRIE  -  CALDF 
IF(COMPAR)  160,150,150 

C  INITIALIZE  THE  DIFFUSION  MOOEL  TO  ISOTHERMAL  CONDITIONS 

150  SMTM  1  (  II   =  0.0 
SMTM  1  ( 2 )   =  0.0 
SMTM 1 ( 3 )    =  0.0 
SMTM  3   =  0.0 
DREDY  =  1 
GO  TO  30 

C  REDEFINE  THE   SURFACE  TEMPERATURE  AND  COMPUTE  THE  NEW  AVERAGE  PACK 

C   TEMPERATURE.     THEN  COMPUTE  THE  MIDDLE  NOOE  AS  A  FUNCTION  OF  THAT 

C   AVERAGE,   THE  SURFACE  TEMPERATURE  AND  THE  GROUND  TEMPERATURE 

[   (WHICH  REMAINED  UNCHANGED) 

160   SMTM  1  ( 1 )    =  AM  1 Nl    (0.0, AVETMC) 
SMTM3  =  COMPAR/IPREWE  *  1.27) 

SMTM 1(2)    =    13.0   •    SMTM3I    -    SMTMllll    -  SMTM1I3I 
SMTMK3I    =  O.J 
DREDY  =  1 
GO  TO  30 

C  THERE   IS   INPUT   TO  THE   PACK  AND  THE   PACK   IS   ALREADY    ISOTHERMAL.  IF 

C   THIS  ENERGY  WILL  CREATE   AT   LEAST  0.05    INCH   (ARBITRARY  AMOUNT )  OF 

c   FREE  WATER.   SET  THE  DIFFUSION  MODEL  TO  STANDBY  STATUS  AND  LET  THE 

C   ENERGY  BALANCE  TAKE   ITS  COURSE 

170  IFIFREWT  ♦   (CALRIE/203.2)   -  0.05)  150,180,180 
180  DREDY  =  0 
IRETRN  =  0 
RETURN 
END 


Subroutine  MIXTUR 


SUBROUTINE  MIXTUR 

C  THIS   SUBROUTINE  CONTROLS   THE   COMPUTATIONS   FOR   A  PRECIPITATION 

C   EVENT   THAT   IS  A   MIXTURE   OF   SNOW   AND  RAIN 

COMMON/ ONL YCR/  AVETMC , BAST MF , CAL OF , CDMAX ,COV ON, DREDY, ENGBL, 

1  ENGBLO.F I  EL  DC, FREWT, LSUSD, NDSNO, ONTRE, PHASE, PREWE, 

2  RCHRG, SMTM1 ( 3) , SMTH3, TCOEF , TMPMLT, TRSHLD,VEGTYP 
INTEGER  DREDY, PHASE .VEGTYP 

COMMON/ WTRBAL /ALLOW, ETFROM, EVAPTR, GENRO, PEAK  ED, PREC I  P.RAO  IN, 
1    RADLWN, RADSWN, TMPMAX, TMPMIN, WATR IN 

C  COMPUTE   THE   AMOUNT  OF   PRF C I P I  TAT  I  ON  OCCURRING  AS  RAIN 

C   AMOUNT   RAIN    =    P    «    (B/A),  WHERE 

C   p    =    PRECIPITATION    IN  INCHES 

C  p.  =  OAILY  MAXIMUM  TEMPERATURE  -  BASE  TEMPERATURE   ( DEGREES  F) 

C   A   =   DAILY  MAXIMUM  TEMPERATURE   -  MINIMUM  TEMPERATURE   (DEGREES  Fl 

0   =   TMPMAX  -  BASTMF 

A    =    tmpmax    -  TMPMIN 

A«TRAN    =    PRECIP    *  (B/A) 

C  vjoh  COMPUTE  THE  AVERAGE  TEMPERATURES   ( OEGR  EES  C)  WHICH  PRODUCE 

C  SNOW  AND  RAIN 

TMSNO  =    (TMPMIN  ♦  BASTMF  -  64.01    •  0.2777777778 

TMAIN    =    I TMPMAX    ♦   BASTMF   -    64.0)    •  0.2777777778 
C  COMPUTE   THE   EFFECT  OF   THE   SNOW  ON  THE  SNOWPACK 
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CALL    SN?W?0  ITMsNO,P»EC|P-AMTRAN) 

q  COMPUTE   THE  EFFECT  OF  THAT   PORT  I  ON  OF   THE  PR  EC  1  P  I  T  ft  T  I  ON  OCCURRING 

C   AS  RAIN  ?N  T»E  SNOWPACK 

CALL  RAINFD  I TMAIN, AMTRAN) 

R-TU->N 
ENO 


Function  PACKRF 


FUNCTION   PACKRF    I  DUMMY) 

C  OFT    THE  REFLECTIVITY  OF   THE  SNOWPACK 

COMMON /ONLYCR  /    iVZ  T  MC  .  8  AS  TMF  .  C  AL  OF  ,  COM  AX  ,  COV  ON  i  DREDY  ,  ENGBL  . 

1  FNGBLO,FICLPC»FRcWT,LSUSO,NOSNO,ONTRF,PHASE»PREWE» 

2  «CHJr, ,  SMTUJ  [31  ,  SMTM3,  TCOEF  ,  TMp ML T , TR SHL 0. V EGT YP 
INTEGER  DREPY.PHASE.VEGTYP 

CiMxO'i/.iTRfUL/ALLtlW.ETFROM,  E  VAPTR.GENRO,  PEftKEO,  PRECI  P.RADIN, 
1    R AOL WN, P A PSWN.TMPM AX, TMPMIN, WATRIN 
DIMENSION  °EFACM(15),REFMLT(15) 
INTEGER  PASINT 

OAT4  REFACM/.80,   .77,   .75,    .72,    .70,   .69,   .68.    .67,   .66,  .65, 
1   ,6<>,   .63,   .62,   .61,  .63/ 
OA T A  REFMLT/.72  ,   .65,   .6C,   .58,   .56,   .54,   .52,   .50,   .48.  .46, 
1    .44,    .43,    .42,    .41,  .43/ 
PASIIT    =  NOSNO 
I F I N  p  S  N  0 )  80,80,13 

C  USE    THC    SftME    FUNCTION   AS   LAST  TIME 

10  IFILSUSOI  20,20,50 

C  ACCUMULATION  PHASE  -  AFTER  15  OAYS,  USE  THE  MELT  FUNCTION 

C   STARTING  AT  THE   FOURTH  DAY 

20  IFIPASINT  -  151  30,30,40 
30  PACKRF   =  REFACHIPASINTI 

OF  TURN 
40  PASINT   =   PASINT  -  11 

C  MELT   FUNCTION  -  AFTER   15  DAYS,   USE  A  CONSTANT  40  PERCENT 

50   IFIPASINT  -   15)  70,70.60 
60  PASINT   =  15 
70  PACKRF   =  REFMLTIPASINT) 
RETURN 

C  THERE   IS  NEW  SNOW  -  OETERHINE  IF  THE  FUNCTION  IS  TO  BE  RE- 

C  INITIALIZED 

80    [FITMPMAX   -   TRSHLOI  90,90,10 

C  IT   IS,   SO  SEE  WHICH  FUNCTION  IS  TO  BE  USED 

90  IF(CALOF)  113,110,100 
100  PACKRF   =  0.91 
LSUSD  =  0 
RFTURN 

C  THE  PftCK  IS  I SOTHERMAL ,  BUT  IF  THE  ENERGY  BALANCE  FROM  THE 

C   PREVIOUS  INTERVAL  WAS  NEGATIVE,  USE  THE  ACCUMULATION  PHASE 

C   FUNCTION  ANYWAY 

110  IFIENGBLO)  100,120,120 
120  PACKRF  =  0.81 
LSUSD  ■  1 
RETURN 
END 


Subroutine  RADBAL 


SUBROUTINE  RADBAL 

c  THIS  SUBROUTINE  COMPUTES  THE  RAOI ATION  BALANCE  AND  TRANSFERS 

C   CONTROL  TO  THE  DIFFUSION  MODEL  THROUGH  SUBROUTINE  LINK   IF  IT  IS 

C   NEEDED 

COMHON/ONLYCR/  AVETMC , BASTMF ,CALOF ,CDMAX ,COVDN, OREDY, ENGBL, 

1  ENGBL 0»FIELDC , FREWT , LSUSD ,NDSNO,ONTRE , PHASE ,PREWE, 

2  RCHRG, SMTM1 (3) , SHTM3, TCOEF, TMPMIT.TRSHLO.VEGTYP 
INTEGER  DREDY, PHASE, VEGTYP 

COMMON/wTR SAL/ ALLOW, £TFR0H.EVAPTR,GENRO,PEAKE0,PREC I P.RADIN, 
1  RADLWN,RADSWN,TMPHAX,TMPMIN,WATRIN 

C  COMPUTE   THE  CALORIC   INPUT  FROM  NET  SHORT  WAVE  RADIATION  AS  A 

C   FUNCTION  OF   THE   SNOWPACK  REFLECTIVITY 

RAOSWN  =  RADIN  •   (1.0  -  PACKRF   (0.0)1   •  TCOEF 

C  IF  THE  PACK  IS  ACCUMULATING,  BUT  IS  NOT  DEEP  ENOUGH  FOR  STABILITY 

C   in  THE  DIFFUSION  MODEL,  USE  THE  FOLLOWING  SIMPLIFIED  METHOD  FOR 

c   DERIVING  THE   RADIATION  BALANCE 

IF(PHASE)  7C,10,110 
10  IFIPREWE  -  4.7)  20,50,50 

C  USE  ONLY  THE   SHORTWAVE  INPUT   (THIS   IMPLIES  THAT  THE  ONLY  COLD 

C   CONTENT  GENERATED  IN  THE  ACCUMULATING  PACK   IS  THAT  OF  NEW  SNOW ) 

20  CALRIE   =  RADSWN 

RAOLWN  -  0.3 

CALL  CALIN  (CALRIE) 

C  MELT  CAN  OCCUR  ONLY  WHEN  THE  MEAN  TEMPERATURE  IS  GREATER  THAN  THE 

C   SPECIFIED  MINIMUM 

I F { AVE  THC   -    TMPMLT)  30,30,40 
30  PREWE   =   PREWE   ♦  WATRIN 

RAOLWN   =  -ENGBL 

ENGBL   =  0.0 

WATRIN   =  CO 

FREWT   —  0.0 

CALOF  =  0.0 
40  RETURN 

C  THE   PACK  HAS  JUST  REACHED  A  SUFFICIENT  OEPTH.     INITIALIZE  THE 

C   DIFFUSION  MODEL ,  BUT  RETAIN  PSEUDO-CONTROL  UNTIL  THE  DIFFUSION 

C   MQDfL   IS  WELL  ALONG  INTO  STABLE  CONTROL 

50  PHASE  =  -1 
60   DREOY    =  1 

PREWE  =  PREWE  ♦  WATRIN 

WATRIN  =  0.0 

RAOLWN   -  -  RAOSWN 

CALDF   =  0.0 

ENGBL  =  0.0 

SMTM1I1)    =   AM1N1    (AVETMC, 0.0) 
SMTMK2I  =0.3 
SMTM1I3)   =  0.0 
FREWT  =  0.3 

RETURN 

C  THE    DIFFUSION  MODEL  HAS   BEEN   INITIALIZED  PREVIOUSLY.      IF   IT  IS 

C   STILL   STABLF   AND   IF   THE   PACK   IS   DEEP   ENOUGH   TO   INSURE  CONTINUED 

C   STABILITY  UNTIL   MELT,   RELINOUISH  CONTROL  COHPLETFLY  TO  THE 

c   NORMAL   METHOD   OF  COMPUTING   THE   RftDIftTION  BALANCE.    INTERFACED  WITH 

C  THE  DIFFUSION  MODEL 


70   IFIOfEOYI    170. SC. 90 
8C  PHASE   =  3 

GO  TO  1 3 
90  C AL R  IE  =  RAOSWN 

CALAIR   =  0.0 

RAOLWN  ■=  C.C 

IFIPREWE   -   5.?)  230.230,100 
100  PHASE   =  1 

C  USE    THE    NORMAL   METHOD   OF   COMPUTING   THE   RADIATION   BALANCE.      IF  ANY 

C   OF    THE    PRFCIP    WAS    SNOW ,    THE    NET    LONG   WAVE    RADIATION    BALANCE  IS 

C  ftSSUMEn  TO  BE  ZERO 

GO  TO  170 

C  SEE    IF   THIS   IS  THE   ACCUMULATION   PHASE  OR   MELT  PHASE 

110  IFIPHASE  -  21  120,170 

C  ACCUMULATING  -   IF   THE  OIFFUSION  MODEL   IS   STILL   READY,   GO  ON  TO  THE 

C   NORMAL   ROUTINE.      BUT   IF  NOT,   JUST  USE  THE   SIMPLE  ONE 

120   I F I  OR  ED Y )  173,130,150 
130  CALRIE   =  RAOSWN 
RADLWN  =  0.0 
CALL  CALIN  (CALRIE) 
IFUVETMC    -    TMPMLT)  140,43,40 
14C   IFIPREWE   -  4.7)  30,63,60 

C  SEE    IF   THE  PEAK  WATER  EQUIVALENT  DATE  HAS  BEEN  REACHED 

150  IFIPEAKEO)*163,170 
160  PHASE    =  7 
170  IFIKDSNO)  180,180,190 
180  RADLWN  =  CO 
CALAIR   =  0.3 
GO  TO  220 

C  TO  COMPUTE   THE   LONG  wftvE  RAOI AT  I  ON  COMPONENTS,   CONVERT  THE  AIR 

C   AND  SNOW  TEMPERATURES  TO  POTENTIAL  CALORIES  BY  THE  STEFAN  - 

C   8L0TZMANN  FUNCTION,  CALORIES  »  S  *  IT  *•  4).  WHERE 

C   s  =  1.17E-7  CAL/I (CM»»2) (DEGREES  KELVIN)*«4),  AND 

c   t  =  ABSOLUTE  TEMPERATURE   ( DEGREES  KELVIN) 

190  CALAIR  =  1.17E-7  »   1 ( AVETMC  ♦  273.16)   •»  4) 
USE  =  AVETMC 

C  IF  THE   SNOWPACK   IS  ISOTHERMAL,  USE  THE  MINIMUM  TEMPERATURE  FOR 

C   COMPUTING  THE   BACK  RADIATION 

IF(CALOF.EO.O.O)  USE  =   (TMPMIN  -  32.0)   •  0.5555555556 

C  UNDER  NO  CIRCUMSTftNCES  MAY  THE  TEMPERATURE  FOR  COMPUTING  THE  BACK 

C  RADIATION  BE  GREATER  THAN  ZERO 

IF(USE.GT.O.O)  USE  =  0.0 

CALSNO  =   1.17E-7  »    ((USE   ♦  273.16)   *•  4) 

c  COMPUTE  THE  LONG  WAVE  RADIATION  COMPONENTS  AS  A  FUNCTION  OF  THE 

C   FIRST,  DETERMINE  WHETHER  THE  SKIES  ARE  CLEAR  OR  CLOUOY 

IFIPRECIP)  200,200,210 

C  WITH  CLEAR  SKIES,   THE  DOWNWARD  LONGWAVE  RADIATION  COEFFICIENT  IS 

C   .757   (RUNOFF  FROM   SNOWMELT,   EH1 1 1 0-2-1406 ,   US   ARMY  CORPS  OF 

C   ENGINEERS,   196C,  PAGE  71 

200  SNOSKY  =   (1.0  -  COVDNI   *   1(0.757  *  CALAIR)  -  CALSNO) 

C  THE  DOWNWARD  LONGWAVE  RADIATION  COEFFICIENT  IS   1.0  BENEATH  THE 

C   FOREST  CANOPY  (OR  BENEATH  CLOUOY  SKIES) 

SNOCAN  =  COVDN  »   (CALAIR  -  CALSNO) 

RADLWN  =  SNOCAN  ♦  SNOSKY 

GO  TO  220 

C  WITH  CLOUOY  SKIES.  WHEN  THE  DOWNWARD  LONGWAVE  RADIATION  COEFFI- 

C   CIENT  IS  1.0  INSTEAD  OF  .757,  THE  ABOVE  THREE  EQUATIONS  MAY  BE 

C   REOUCEO  ALGEBRAICALLY  TO  THE  FOLLOWING  SINGLE  EQUATION 

210  RADLWN  =  CALAIR  -  CALSNO 

C  COMPUTE  THE  CALORIC   INPUT  OR  LOSS  FROM  THE  NET  EFFECT  OF  SHORT 

C   WAVE   AND  LONG  WAVE  RADIATION 

220  CALRIE  =  RADSWN  ♦  RADLWN 

C  THE   SNOWPACK  TEMPERATURE  DIFFUSION  MODEL   I  LEAF,   1970.   STUDY  PLAN 

c   FS-RM-16C2,  NO.   224.     ROCKY  MOUNTAIN  FOREST  AND  RANGE  EXP  STAI  IS 

C   INCORPORATED  To  CONTROL  THE  SNOWPACK  TEMPERATURE  AND  COLD  CONTENT 

C   DURING  NON-ISOTHERMAL  CONDITIONS.     SEE  NOW   IF  THE  DIFFUSION  MODEL 

C   MAY  8E  USED   IDREDY  MAY  NOT  BE  -1  AND  PASS  THROUGH  LINK  SINCE  IT 

C   I s  NOT  DESIGNED  TO  WORK  WITH  IT.     THE  -1   IS  USED  TO  INDICATE  THAT 

C  THE  P  AD  I  ft T I  ON  ROUTINES  ARE  TO  BE  USED  EXCLUSIVELY).     IF  IT  MAY  BE 

C   USED,   PASS  THROUGH  THE  LINKING  ROUTINE  WHICH  INTERFACES  THE 

C   OIFFUSION  MODEL  AND  THE  RADIATION  ROUTINES 

I F I DREDY )  240,230,230 

230  CALL  LINK   (CAL AIR, CALRIE, IRE TRN) 
IFIIRETRNI  240,240,260 

240  IFICALRIE)  250,260,270 

250  CALL  CALOSS  (CALRIE) 

260  RETURN 

270  CALL  CALIN  ICALRIEI 
RETURN 
END 


Subroutine  RAINED 


SUBROUTINE   RAINED   I TR A I N , AMTRAN I 

C  THIS  SUBROUTINE  COMPUTES  THE  EFFECT  OF  RAIN  ON  SNOW 

COMMON /ONLYCR/  AVETMC , BASTMF , CALDF , CDMAX , COVON , DREDY , ENGBL , 

1  ENGBLCFIELDC  » FREWT ,  LSUSD  »NDSNO»ONTRE » PHASE,  PREWE. 

2  RCHRG. SMTM1I3) , SMTM3, TCOEF, TMPMLT, TRSHLD, VEGTYP 
INTEGFR  OREDY, PHASE .VEGTYP 

COMMON /WTR8A L /ALL OW, E TF ROM, EVAPTR,GENRO, PEAK  ED, PREC IP, RAO IN, 
1   RADLWN, RAOSWN, TMPMAX, TMPMIN, WATRIN 
C  ADD   THIS  AMOUNT  OF  PRECIPITATION  TO  THE  PREDICTED  WATER  EQUIVALENT 

PREWC   =  PREWE  ♦  AMTRAN 
C  SEE   IF   THERE   IS  A  CALORIE  DEFICIT   IN  THE  PACK 

IFICALDF)  50.50.10 

C  COMPUTE   THF  AMOUNT  OF  RAIN  AT  THIS  TEMPERATURE  THAT   IS  NEEDED  TO 

C   WIPE  OUT  THE  DEFICIT  AND  COMPARE   IT  WITH  THE  ACTUAL  AMOUNT 

10  C  ALP  AN  =  (80.0  ♦  TRAIN)   *  2.54 

AMTNED   =  CALDF/CALRAN 

CQMPAR   =   AMTRAN  -  AMTNED 

IFICOMPARI  30.20,40 

C  THERE  WAS  JUST  ENOUGH  TO  WIPE  OUT  THE  DEFICIT 

20  CALDF  =  0.0 

ENGBL  =  ENGPL  *  C AL R AN 

RETURN 

C  THERE  WAS  NOT  ENOUGH  TO  WIPE   IT  OUT  COMPLETELY.     JUST  DEPLETE 

C  THE  OEFICIT 

30  CALDF  =  CALOF  -  (CALS5N  »  AMTRAN) 
ENGBL  =  CNGPL  »  (CALRAN  «  AMTRAN) 
RETURN 

C  THERE  WAS  MORE  THAN  ENOUGH  TO  WIPE  OUT  THE  OEFICIT.     THE  AMOUNT 

0   OF   RAIN  NOT   FROZEN   IS  FREE  WATER 

43  FREWT   =  COMPAR 


27 


CALL   CAL1N   (TRAIN  »  COMPAR   •  2.54) 

RETURN 

C  ALL    nF    THF    RAIN    IS   ADDED    TO   THE    FREE   WATER    AND   CONTRIBUTES  CALORIC 

C   INPUT    TO    THF  PACK 

5C   FPEXT    =   FREWT   +  AMTRAN 

CALL    C1LIN    (TRAIN   •    AMTRAN    »  2.54) 

RETURN 

CUR 


Subroutine  SNOWED 


SUBROUTINE   SNOWED   ( T SNOW , AMT SNO I 

C  THIS   SU8RCUTINE   COMPUTES  THE   EFFECTS   OF   A  SNOW   EVENT   ON  THE 

c  SNO>.->ACK 

COMr'  ON/TIL  VCR/  AVETMC,BASTMF,CALDF,CDMAX,C0VDN,0REDY,ENG8L, 

1  ENGBLCFl  EL  DC,  FREWT,  LSUSD.NDSNO.ONTRE,  PHASE,  PREWE, 

2  RCI'RC, SMTM1 I 31 , SMTM3, TCOFF , TMPML T , TRSHL 0 . VEGTYP 
INTEGER   DREOV, PHASE. VEGTVP 

COMMON/WTPBAL/ALLnw»ETFROM, EVAPTR, GENRO, PE AK ED, PR  EC  I P , R AD  I M , 
1  RARLWN,RADSWN,TMPMAX,TMPMIN,WATRIN 
REAL  INTCPT 

C  SEE    IF    INTERCEPTION   IS   ALLOWED  NOW 

IF(ALLCW)  10,30 

C  DETERMINE  THE  AMOUNT  OF   INTERCEPTED  SNOW  AS  A  FUNCTION  OF  COVER 

C   COMPOSITION   ANO  COVER   OENSITY   (WATCH   FOR  OPENINGS   AND  OECIDUOUS 

C   FORESTS   WITHOUT  FOLIAGE) 

1C  IF(COMAX)  20,30 

20  GO  Tr   (HO, 50, 40, 30) .VEGTVP 
C  NO  INTERCEPTION 

30  INTCPT  =  CO 
GO   TO  90 

C  LODGEPOLE   PINE   AND  FOLIATED  DECIDUOUS  FORESTS 

40  PERCNT   =  0.10 

GREAT  =  0.20 

GO  TO  60 

c  SPRUCE  FIR 

50  PERCNT  =  0.15 

GREAT  =  0.30 
60   INTCPT  =  AMTSNO  *  PERCNT  *    ! COVDN/C  DMAX ) 

I F ( ONTRE   *   INTCPT  -  GREAT)  80,80,70 
70   INTCPT   =  GREAT  -  ONTRE 
80  ONTRE   =  OMTRE   +  INTCPT 
90  NDSNO  =  0 

C  ADD   THIS  AMOUNT   OF   PRECIPITATION  TO  THE   PREDICTED  WATER  EQUIVALENT 

PRE w E  =  PREWE  *  AMTSNO  -  INTCPT 

C  THE   SNOW  FALLING  WHEN  THE  TEMPERATURE   IS  BETWEEN  35  AND  32  DEGREES 

C   DOES  NOT  ALTER  THE  CALORIC  DEFICIT 

IF(TSNOW.GE.S.O)  RETURN 

C  COMPUTE   THE  CALORIE  DEFICIT  FOR  THIS  SNOW  BV  THE  EOUATION 

C   CALORIE  OEFICIT  =  S(I)«DELTA  T*P,  WHERE 

c   SII)   =  SPECIFIC  HEAT  OF   ICE   (.5  CAL/CM/ DEGREES  C). 

C   DELTA   T  =  CHANGE    IN  TEMPERATURE  WITH  RESPECT  TO  FREEZING  (0.0 

C   DEGREES  CENTIGRADE),  AND 

c   p  -  PRECIPITATION  IN  CM  (CONVERSION  FACTOR  =  2.54  CM/IN). 

c   THEREFORE,   CALORIE   DEFICIT  -  0.5  »   ITFORSNOI   »   ( AMTSNO  *  2.54) 

CALL  CALOSS   ( TSNOW  »   (AMTSNO  -   INTCPT)    *  1.271 

RETURN 

END 


Subroutine  SNOVAP 

SUBROUTINE  SNOVAP 

C  COMPUTE   THE   EVAPORATION  FROM  THE   SURFACE  OF   THE   SNOWPACK   AS  A 

c   FUNCTION  OF   THE   COVER   DENSITV  AND  REDUCE  THE  PACK  ACCORDINGLY 

COMMON/ONLYCR/  AVET MC , B ASTMF , C AL DF , COMAX , COV ON, DREDY, ENGBL. 

1  ENGBLO,F!ELDC, FREWT, LSUSD, NDSNO , ONTRE , PHASE, PR EWE, 

2  RCHRG. SMTM1 (3) , SMTM3 , TCOEF , TMPMLT , TRSHL D, V EGT YP 
INTEGER   OREDY, PHASE .VEGTVP 

COMMON/WTRBAL/ALLOW.ETFROM,EVAPTR,GENRO,PEAKED,PRECIP,RADIN, 
1    RAOLWN.RADSWN, TMPM AX , TMPM I N .WATRIN 
ETFROM    =  2.0 

EVAPTR    =   (1.0  -  COVDNI    *  EVAPTR 

C  SINCE  DECIDUOUS  FOREST   AREAS   MAY   EVAPORATE  FROM  THE   SNOWPACK  WITH 

C  NO  REGARD  FOR   PACK   DEPTH,   00  NOT  ALLOW  EV APOTR ANSP I R AT  I  ON  TO  TAKE 

C   MORE    THAN    IS    IN   THE  PACK 

IFIPREWE  -  EVAPTR)  10,10.20 
10  EVAPTR   =  PREWE 

PREWE   =  0.0 

RETURN 

20  PREWE  =  PPEWE  -  EVAPTR 
RETURN 
END 


Subroutine  DECDUS 


SUBROUTINE  DECDUS 

C  CHECK  FOR  A  CHANGE  OF  SEASON  IN  OECIDUOUS  FORESTS 

COMMON/ M/ALTYR( 8  I .BOUND (6, 8  I , C ALDEF ( 8  I , C OVDE N ( 8  I , CUT  (  8  I  , 

1  DECIDSI2,8),0READY(3) , ENG8AL ( 8 ) , EX PK ( 8 ) , EXPK1 ( 8 ) , FREW AT ( 8 ) , LAST  1, 

2  LASUS0I8) ,LCOPY( 14  I .NDYSNOIS) , NEXTYR .NPLAN, NUM. NUN  IT , ONTRE S( 8 )  , 

3  PAR  AMI  9)  ■ PHASE ( B ) , PHI  SOI  8  I  , PREWEOI 8 )  ,RD  1ST  I  8 ) , RDM AX ( 8  I ,RECHRG( 8 ) , 

4  RFGROWI 2, 8) ,RUNUM( 8) ,RUWT( 81  , S E 0 1 NC , SEE  OAT (2),SEFDYR(2), 

5  SIMTMK  3,8)  .TCOEFF  (8)  ,TY?CUT  (8) 

INTEGER  ALTYP .BOUND .DREADY , PHASE, RUNUM,SEFDAT,SEEDYR , TYPCUT 
COMMON/UTI LTY/ BLOCK (  18  89) , CH ANGR , CHANGW , 0 ATE  I  2 ) . DAT E S I  4 ) , L I NES , 
I   NAMc ,NDJY,RCHR&:,R0(3  72) ,WE I  372) , WEO , YE AR . VRTOT I  3 ) 
INTEGER   DATE , DATES, YEAR 

DIMENSION  BIMNTHI6)  ,ET0I372),PPTI372) , R AD  I  372 ) , TMAX I  372  I , TM I N I  372) 
EOUI VALENCE    I  BLOCK  I 2),TMAXI1I),(BL0CK(374I,TMIN(1)),( BLOCK  I  746  I > 

1  PPT(1)),(PL0CK(111H),RA0(1II  , I  BLOCK  I  14901 ,ETO( 1) ), I  BLOCK  I  1864  1  , 

2  CD."  AX)  ,  (BLOCK  I  1865  )  .VEGTYP  I  ,  (  BLOCK  (  1 866  I  ,  TR  SHL  D  ) ,  (  BLOCK  (  1867)  ■ 

3  TMPMLT I , ( BLOCK (1868) , W I L TPT I . I  BLOCK ( 1 87 1  I , DC  DM  AX  I ,  I  BL OCK  I  1 872  I  , 

4  I  S:iT3MI  ,  (  BLOCK  (  18731  ,PEKDATI  ,  I  BLOCK  (  1880)  ,  BIMNTHI  II), 

5  I  BLOCK  I  1836  1 .PEAKWE I , I  BLOC K 1 1 8 8a ) , PE AKR C I 
INTEGER  PEKDAT, VEGTYP 

C  CHECK  THE  DATE   I  BETWEEN  APRIL  1   AND  OCTOBER  15,    IT   IS  POSSIBLE  TO 

C   HAVE   FOLIAGE.      BUT  DURING   THE   REMAINDER  OF   THE  YEAR.    IT  IS 


C   ASSUMED  THAT  THE  TREES  ARE  LEAFLESS) 

IFCinAY.GE.lB7.OR.NOAY.LE.15l    GO  TO  30 

C  THE    TREES    SHOULD    BE    LEAFLESS.      IF    THEY    ARE   NOT,    SWITCH  TO  THE 

C   LOWER  COVER  DENSITY 

10    IFIVrGTYP   -   4)    2', 80 
20   VEGTYP    =  4 
GO  TO  60 

C  THE    FOLIAGE    MAY   BE    PRESENT,    BUT    IF    THE    PACK   WATER   EOUIVALENT  IS 

C   MORE   THAN  5   INCHES,   THE  TREES  ARE  STILL  ASSUMED  TO  BE  LEAFLESS 

30  DO  4"    I   =   1, NUN  IT 

IFIPREWEOIIl   -  5.0)  40,40,10 

40  CONTINUE 

C  THE  FOLIAGE   SHOULD  BE  PRESENT.     IF  NOT,   SWITCH  TO  THE  HIGHER  COVER 

C   DENSITY 

IFIVEGTYP  -   3)  50,80 
50  VEGTYP  =  3 
60  DO   70   I   =  l.NUNIT 

TCOEFFII)   =  SWITCH   I TCOEFF ( I  I ,DECIDS( 1,1 ) I 
COVOENII)   =  SWITCH   ICOVOENI I  I .DECI0SI2, 1 ) ) 
CDMAX    =    SWITCH    ( COM  A  X , DCDMAX ) 
70  CONTINUE 
80  RETURN 
END 


Subroutine  GBIMON 


SUBROUTINE  GBIMON 

C  GET   THE   BIMONTHLY  RUNOFF 

COMMON/UTILTY/BLOCK I  1 889 ) , CHANGR , CHANGW, DATE  I  2  I . DATE S ( 4  I , L I NES , 
1  NAME,NDAY,RCHRGO,RO(  37  2) , WE  13721  , WEO , YE AR , YRTOT ( 3 ) 
INTEGER  DATE, DATES, YEAR 

DIMENSION  BIMNTHI 6) .ET0I372) , PPT  1372) , RAD  1 372 1 .TMAX I  372 ) ,TM INI  372) 
EQUIVALENCE   (BLOCK! 2) ,TMAX( 1 ) I , I  BLOCK  I  374) , THIN  I  1 1 ), I  BLOCK  I  746) , 

1  PPTI1) ) , (BLOCK  1 111B), RADII) I , I  BLOCK  1 1490 ) , ETO 1 1 1  I , I  BLOCK ( 18641 , 

2  COMAX) , (BLOCK!  1865)  , VEGTYP) , I  BLOCK  1 1866  I .TRSHLO ) , ( BLOCK! 1867), 

3  TMPMLT) , (BLOCK! 1868) , W I LT PT ) , ( BLOCK ( 1 87 1 ) , DCOM AX  I , ( BLOCK  I  1 872  I , 

4  ISOTRMI , (BLOCK! 1873) .PEKDAT) , (BLOCK! 1880) .BIMNTHI II), 

5  (BLOCK!  1886) , PE AKWE I , I  BLOCK (  1888) .PEAKROI 
INTEGER   PEKDAT, VEGTYP 

C  APRIL   16  -  APRIL  30 

BIMNTHU)   =  0.0 
DO   1 ?  1   =  202,216 
10   BIMNTH(l)    =   BIMNTHI 1 )    ♦  ROIII 

C  MAY  1  -  MAY  15 

BIMNTHI2I   *  0.0 
DO  20   I   =  218.232 
20  BIMNTHI2)   =  BIMNTHI 21   ♦  RO(I) 

C  MAY    16   -   MAY  31 

B I  MNTH I  3  I    =  CO 
DO  30  I   =  233,248 
30  BIMNTHI3I    =  B I MNTH I  3 )   *  RO(I) 

C  JUNE   1  -  JUNE  15 

BIMNTHI4)   =  0.0 
DO  40  I   =  249,263 
40   BIMNTHI4)    =   BIHNTHI4I    ♦  RO(I) 

C  JUNE    16  -   JUNE  30 

BIMNTHI5I   =  0.0 
00  5C   I   =  264,278 
50  BIMNTHI5)    =  B I MNTH I  5  I    ♦  ROIII 

C  JULY  1  -  JULY  15 

BIMNTHI6I    =  0.0 
DO  60   I   =  280,294 
60  BIMNTHI6I    =  B I MNTH ( 6 1   ♦  ROIII 
RETURN 
END 


Subroutine  GPEAK 


SUBROUTINE   GPEAK   ( I  DATE  1 1 

C  GET   THE  PEAK  7-DAY  FLOW  ANO  PEAK  WATER  EQUIVALENT 

COMMON/UTILTY/BLOCK (1889 1  .CHANGR , CHANGW . DATE  I  2 ) , DATES ( 4 1 , L INES , 
1  NAME ,NOAY,RCHRG0,RO(372l , WE (372  I ,WEO, YE AR . YRTOT 1 3 ) 
INTEGER  DATE, OATES, YEAR 

DIMENSION  BIMNTHI 6) ,ETOI 372 ) , PPT (372) , RAD! 372) ,TMAX (372) ,TMIN!  372) 
E0U1 VALENCE   I  BLOCK! 2) ■ TMAX 1 1 1 ) , I  BLOCK  I  374) ,TMIN( III,! BLOCK! 746), 

1  PPTIlll,  (BLOC  KIU18I,  RAD  (111  ,  I  BLOCK!  14901  ■  ETO  1 1 1  ) ,  I  BLOCK  1 1864 )  • 

2  COMAX) , I  BLOCK!  1865  > , VEGTYP ) .( BLOCK ( 1866 ) .TRSHLD) ,( BLOCK ( 1867), 

3  TMPMLT) , (BLOCK!  1868) .W1LTPT) , I  BLOCK  1 187 1 1 , OCOMAX I , I  BLOCK!  1872), 

4  I  SO TRM) , (BLOCK! 1873) .PEKDAT) , I  BLOCK  1 1880 1  , BIMNTHI 111, 

5  (BLOCK!  1886) , PE  AKWE  > , ( BLOCK { 1888 ) .PEAKROI 
INTEGER  PFKOAT, VEGTYP 

C  PEAK  WATER  EOUIVALENT 

PEAKWE  =  CO 

PEKDAT    -  1 

DO   4:    I    =  1,372 

IFITMAX(I)    «    1.E50)  10,40 
10  IFIPEAKWE  -  WE(II)  20,30,40 
20  PEAKWE   =  WEIII 
30  PEKOAT  =  I 
40  CONTINUE 

CALL  GDATE   ( PE KD AT , DATE ) 
c  7-DAY  PEAK  FLOW 

IDATEi   =  1 

I  DATE  2  =  7 

PE AKS  n  =  0.3 

DO   11?    I    =  187,272 

IF! TMAX! I  I  ♦   1.E50)   50,  11C 
50  ACCUM  =  ROIII 

J  =  6 

K   =   I   ♦  1 
60    IFITMAXIKI    ♦    I.E50I  7^,80 
70   ACCUM    =    ACCUM   ♦  ROIK) 

J    =    J   -  1 

IFU)  b;, 90 

80   K    =   K   +  1 
CO  TO  6: 

90    IFIPEAKRO  -   ACCUMI  100,110,110 

IOC  PEAKRfl  =  ACCUM 
IOAT-1   =  I 
IDATE2  =  K 
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Ill  CONTINU-" 

 CONVERT   THE  OATiS 

CALL  GOAT'-  llOATEliDATESIl)  I 
CALL  r-n.\T£   ( IDATE2,OATES(3! I 

°ETu-iN 
FNn 


Function  TC 


Function  JWYDAT 


F'lNCTIO.    JkYOAT  IMONTH.IDAYI 

[  CONVERT   THC   DATE   TO  A  PSEUDO-JULIAN  DATE  SYSTEM,  WHERE 

C   pay    I.      CONSIDER    ALL    MONTHS    IS   HAVING   31  OAYS 

c  "SrUUC-JULlAN  WATER   YEAR  DATE   CONVERSION  TABLE 

C  DAY     OCT     NOV     DEC     JAN  FEB  MAR  APR  MAY  JUN  JUL 

C                 1         1       32       63       94  125  156  187  218  2*9  2BO 

C                 2         3       33       64       95  126  157  IBB  219  250  281 

C                 1         3       34       65       96  127  158  189  220  251  282 

C                 4         4       35       66       97  128  159  190  221  252  283 

C                 '.         5       36      67       98  129  160  191  222  253  284 

C                 6        6       37       68       99  1  30  161  192  223  254  285 

C                 7         7       3'       69     10>  131  162  193  224  255  286 

C                 ?.         8       3  9       70     101  132  163  194  225  256  287 

C                 9         o      40       71     102  133  164  195  226  257  288 

C               1C       10      41       72     103  134  165  196  227  258  289 

C               11       11       4^       73     104  135  166  197  228  259  290 

C               12       12       43       74     105  136  167  198  229  260  291 

C                u       13       44       75      1C6  137  168  199  230  261  292 

C                 13        13       44       75     106  137  168  199  230  261  292 

C               14       14       45       76     107  13B  169  200  231  262  293 

C                 15        15       46       77      108  139  170  201  232  263  294 

C               16       16       47       78     109  140  171  202  233  264  295 

C               17       17       43       79     110  141  172  2C3  234  265  296 

C               18       IB       49       BO     111  142  173  204  235  266  297 

C               11       19       50       81     1  12  143  174  205  236  267  298 

C               Ij       7:       51       92     11  3  144  175  206  237  268  299 

C               21       21       52       83     114  145  176  207  238  269  300 

C               22       22       53       B4     115  146  177  208  239  270  301 

C               23       23       54       85     116  147  178  209  240  271  302 

C               24       24       55       86     117  148  179  210  241  272  303 

C                25       25       56       87     118  149  180  211  242  273  304 

C               26       26       57       88     119  150  181  212  243  274  305 

C               27       27       58       89     120  151  182  213  244  275  306 

C               28       28       59       90     121  152  183  214  245  276  307 

C               29       29       60       91     122  153  184  215  246  277  308 

C   3p       30       61       92     123  185  216  247  278  309 

C   31       31  93     124  186  248  310 

IFIMONTH  -   101  30,20,10 

C  N0VEu0ER  -  DECEMBER 

10   JWYOAT    =    t ( MON TH- 101*311  »  I0AY 

CO  TO  4  3 

C  OCTOBER 

20  JWYDAT   =  IOAY 

GO  TO  40 

C  JANUARY  -  SEPTEMBER 

30   JWYCAT    -    I (M0NTH*2)*31 )    ♦  I  DAY 

40  IF[ JWYDAT. GT.O. AND. JWYDAT . LT . 3731  RETURN 

WRITE   (6,9101   MONTH, IDAY 

91C  FORMATOOINVALID   MONTH/ DA  Y*  I  5  ,  •/ •  1 2  ,  •  -   JOB  ABORTED*  ) 

CALL  ABORT 

END 


AUG 
311 
312 
313 
314 
315 
316 
317 
318 
319 
320 
321 
322 
323 
323 
324 
325 
326 
327 
328 
329 
3  30 
331 
332 
333 
334 
335 
336 
337 
338 
339 
340 
341 


SEP 
342 
343 
344 
345 
346 
347 
348 
349 
3  50 
351 
352 
353 
354 
3  54 
355 
356 
357 
358 
359 
360 
361 
362 
363 
364 
365 
366 
367 
368 
369 
370 
371 


Subroutine  OUTPT 


SUBROUTINE  OUTPT 

C  OUTPUT  THE  COMPILED  RESULTS  AND  WRITE  THE  BASIC  DATA  ON  THE  FILE 

COMMON  DAT  I  ME (2  I , DECMAL , NRMANG, NSAVEO ,NYE ARS , PLNOPT ( 1 9  I , PLUN I T ( 6  I , 
1  REC0VR.REG1ONI 81 ,R6G0PT(5I , SAVE .SEDRN2 , WE IGHT 
INTEGER  DA  TIME, PLNOPT, PLUNI T , RECOVR , R EGI ON, REGOPT, S AVE, SEDRN2 
COMMON/UTILTY/BLOCK 1 1889) , CH ANGR , CH ANGW , DAT E ( 2  I , DAT ES ( 4 1 , L I NES , 
1  NAM E.NDAY.RCHRGO.R 0(372) , WE (372) , WEO , YE AR, YRTOT ( 3 ) 
INTEGER   DATE , DATES, YEAR 

DIMENSION  BIMNTHI6) ,ET0(372),PPT(372),RAD(372),TMAX(372I,TMIN(372) 
EQUIVALENCE   (BLOCK! 2  I , TMAX ( 1 ) I , (BLOCK (374) ,TMIN( 1) I , ( BLOCK ( 7461, 

1  PPTI 1 ) )  ,  (BLOCK! 1118) ,RAO( 1 ) ) , ( BLOCK ( 1 490 1 , ETO ( 1 1 ) , ( BLOCK ( 1 864) , 

2  C DM AX) , (BLOCK! 1365 ) .VEGTYP) , ( BLOCK ( 1 866 ), TRSHLD ) , ( BLOCK! 1867) , 

3  TMPMLTI , (BLOCK! 186BI , W I L TP T I , 1  BLOCK ( 1 87 1 ) .DCOMAXI , I  BLOCK! 1872), 

4  IS0TRM),IBL0CK(  1873I,PEKDATI ,( BLOCK  I  1880 ) ,8IMNTH(  1 ) ), 

5  I  BLOCK (  1 886 ) , PE AKWE 1 , ( BLOCK ( 1888  I , PEAKRC) 
INTEGER   PEKDAT,  VEGTYP 

INTEGER  HEA0ERI2I 

DATA  HEA0ER/8HNATURAL   .8HALTERED  / 

C  CHECK  THE  LINE  COUNTER 

lF(LINES)  10,10,20 
10   WRIT'    (6,910)    REGION, 0 A T I  ME , PLUN I T ,HE ADE R I NRMANG I 
910  FOPM AT  I « 1* PA  10, 32X2  All/ 1X6A10.54XA8. 'CONDITIONS*/ 

1    *C  YE  AR        -   -   -   -BI  MONTHLY   GENERATED  RUNOFF   ------ 

2YEARLY  ------         9/30       -    -  -  -  -  PEAK  ------  -*/ 

3  *  APRIL        MAY  MAY  JUNE        JUNE        JULY  GEN 

4  CHANGE  CHANGE       RECH  7-DAY*/ 

5  «  16-30       1-15     16-31       1-15     16-30       1-15  RO  PPT 

6  ET       RECH       w.F.         REQ       W.E.       DATE     GENRO  DATES*/) 
LINES  =  5C 

C  PRIST   THE  LINE 

20    WRITE    (b,°2j)    YEAR  ,  P I MNTH, YRTOT , CHANGR , CHANGW , RCHRGO, PEAKWE .DATE , 
1   PEAKRO, DATES 
920  F0RMAT(2XI3,1X13FT.2,2XI2,*/»I2.F7.2,2(2XI2,*/«I2)I 
LINES  =  LINES  -  1 
RETURN 
END 


Function  SWITCH 


FUNCTIC'.    TC  ICO) 

C  GENERATE    THE    TRANSMI SSI  VI TY   COEFFICIENT    WHICH   CORRESPONDS    TO  THE 

C   SPEC1FIE0  COVER  DENSITY 

C  THE    .06   BELOW    IS   PEPE-lOENT    ON   THE   FUNCTION   VALUFS    AT    STATFMENT  40 

IFICP  -   .:6)  10,10,20 
10  TC  =  I.' 
RETURN 

20   IFICO  -    l.CI  40.30,30 

30  TC  =  :.o 
RETURN 

c  THE   FOLLOW  I NG  RELATIONSHIP  REPRESENTS   THE   RESULTS  0BTAINE0  OURING 

C   TH;   CALIBRATION  OF    THE   WATER   BALANCE   M00EL   WHEN  THE   COVER  DENSITY 

C  AND   TRANSMI SSI  VI TY  COEFFICIENT  WERE   ALLOWEO  TO  VARY   TO  ESTABLISH 

C   REASONABLE   MELT   RATES   UN   EACH  OF  THE   ERASER   EXPERIMENTAL  FOREST 

C   SUBSTATIONS   IN   1969.     ONCE   A  COMBINATION  HAD  BEEN  ESTABLISHED, 

C   IT   WAS   TESTED  FOR   29  OTHER   YEARS   AND  WAS   FOUND  TO   BE  SATISFACTORY 

40  TC   =  0.1(1995/(CD  «*  0.57861 

RETURN 

END 


Program  NORMAL 


FUNCTION    SWITCH    ( VALNOW . S TORE D) 
-SWITCH   THE   PR  E  St  NT   VALUE   AND   ITS   STORED  COUNTERPART 

SWITCH  =  STORED 
STOR=P  =  VALNOW 
RETUfN 


OVERLAY  (OLAYS.2,11 
PROGRAM  NORMAL 

0  pEBFQi>M   THE   NORMAL   SIMULATION  AND  CREATE   THE   BASIC  OATA  FILE 

COMMON   DATIME (2  I  , DEC MAL , NRMANG , NS AV ED , NY E ARS , PLNOPT I  1 9  I , PL  UN  I T I  6 ) , 
1   REC0VR,REGI0N(8I , REGOPT I  5 )  , S AVE , SE0RN2, WE IGHT 
INTEGER  D AT  I  ME, PL  NOP T, PLUN I T, RECOVR, REG  I  ON, REGOPT, SAVE, SE0RN2 
COMMON/N/ACCUM,AIRTMC (4I,ASPECT,CALDEF,C0VDEN,DECIDS(3), DREADY, 

1  FNGPAL .ETOALYI 121  , FR AC TN , FRE WAT , I D , I M , I MN, I  MX, IP,  I V , L ASUSD, L AT, 

2  NDYSNO.ONTRES, PEKPPT , PHASE , POTENT ( 24) , POTRAD, PP TNOW , PR E WEQ , 

3  PAP  SUB, RECHPG, SI MTM1I3I, SLOPE, SLPASPI24  ),  SUMMER  ,  TCOE  FF  , 

4  VARFMT! 7) , VAP 1 N ( 6 ) 

INTEGER  A  SPEC T, DREADY, PHASE , RADSUB , SLOPE ,VARFMT 
COMM0N/TIME/CANREF,CDMAX2,CONAV 

COMMON/UTILTY/BLOCK 11889) , CHANGR , CH ANGW , DATE ( 2 ) , OAT  ES 1 4 ) .LINES, 
1  NAME, NOAY.RCHRGO.RO I  3721, WE (372), WEO, YFAR, YRTOT 13) 
INTEGER   DATE, DATES, YEAR 

DIMENSION  B I MNTH I  6 ) , ETO (37 2  I , PPT  I  37 2 ), RAO (  372  I , TMAX (  372  I , TM I N I  372  I 
EQUIVALENCE   1  BLOCK! 2) , TMAX! 1 ) ) , I  BLOCK  1374) ,TM[N( 1) ) , ( BLOCK! 746 ) , 

1  PPT  I  1 ) I , (BLOCK! 11181, RAD  111) , I  BLOC K ( 1 490  I ,ETOI II ) , ( BLOCK  (  18641, 

2  COM  AX ) , (BLOCK!  1865  ) , VEGTYP) , (BLOCK (1866 ), TRSHLD) , (BLOCK!  1867) , 

3  TMPMLTI , (BLOCK  I  1 868  I , WI LTPT ) , ( BLOCK ( 1 87 1 ) , DCDH AX ) , I  BLOCK!  18721  , 

4  I  SO T» Ml , ( BLOCK (  1873) .PEKDAT) , (BLOCK! 18801  , 8 IMNTHt 1 ) ), 

5  I0LOCK I  18961  .PEAKWE) , ( BL OCK I  1 888  I , PE AKR 0 1 
INTEGER  PEKDAT, VEGTYP 

C OMMON / WTRBAL/AL LOW, ETF ROM, EVAPTR, GENRO, PEAKED, PREC IP, RAD  IN, 
1  RADLWN,RADSWN,TMPMAX,TMPMIN,WATRIN 
CALL  CORE  (-11 
REWIND  16 

C  IF  THIS   IS  FOR  OATA   BASE   EXTENSION  ONLY,    BYPASS  THE  NORMAL  PARTS 

I F ( NRMANG. EO.O  >   GO  TO  100 
C  READ    THE    STATION  PARAMETERS 

CALL    GP  AR  AM 

ENGBAL  =  C.'j 

FRE  W  AT   =  0.0 

LASUSD  = 

NDYSNO  =  0 

ONTRES  -  0.0 

PHASE  =  C 

RCHRGO    =  RECHRG 

WEO  =  PREWEQ 

BL0CKI1B62)    =  TCOEFF 

BLOCK! 1B63)    =  COVDEN 

BL0CKI1869)   =  OECIOS(l) 

BLOCK! 1370)    =  0ECIDSI2) 

BL0CK1187I I   =  DEC  I DS ( 3  I 

C  THE   TIME   RELATEO  PARAMETERS   MUST   BE  DEFINED  FOR  USE    IN  SUBROUTINES 

C  CANVAP   AND  E VTR AN ,    EVEN  THOUGH   THEY  REMAIN  CONSTANT 

CDMA  X  2   =  COMAX/2.0 

IFICOVDENI  10,20 
10  CONAV   =  0.5 

CANREF  =  C.9 

GO  TO  3; 
20  CONAV  =  1.0 

CANREF  =  :.5 

C  PRINT  THE   TITLE   SHEET  IF  THE  OUTPUT   IS  TO  BE  PRINTED 

30   IFIPLNOPTI 1  I .NE.O)   CALL  TITLEN 
LINES  =  0 

c  pERFORM    THE    SIMULATION   ON   EACH   YEAR   AS    A   UNIT.      READ   THE  SPECIFIED 

C   CONDITIONS  CARD   AND  THE   DATA  FOR  THE   NEXT  YEAR 

40  CALL  GET1YR  (IENO) 

I F  (  I  SMO.NE.D)   GO  TO  90 

BL0CKI1374I   =  PREWEQ 

BLOCK! 19  75)    =  RECHRG 
C  PERFORM   THE   SIMULATION  ON  EACH  DAY 

PPTNOW    =  C.C 

ALLOW  =  1.0 

00  5 :  I   =  1,3 
50  Y°  TO  T ( I )   =  0.0 

DREADY  =  : 

DO   90  ':OAY   =  1,372 

IF!  TMAX  ( 'IDAY  I    ♦   1.E50)  60,80 

C  GENERATE  THE  DATA  FOR  THIS  DAY 

60  CALL  OENOAT 
C  MAKE   THE   PASS   THROUGH  THE   WATER   BALANCE  ROUTINES 

CALL   WAT9AL    !CALOEF,CDMAX, COVDEN, DREADY, ENGBAL, FREWAT, LASUSD, 

1  NDYS  NO, 0*1  TRES, PHASE, PREWEQ, RECHRG,  S1MTM1!  1 ) ,  S  IMTM1  (  2  ) ,  SIMTMK  3  ) , 

2  TCOEFF, TMPMLT, TRSHLD, VEGTYP, W I LTPT I 
C  STOr-c   THE  c  E  RESULTS 

WE(ND'.Y)    =  PREWEO 

'0! 'I DAY  I    =  GENRG 

YRTOT(l)    =   YRTOT(l)    »  GENRO 

YRTOT! 3 )    =    YRT0TI3I    ♦  EVAPTR 
C  WATCH  FOP    THE   MANDATORY   ISOTHERMAL  DATE 

IF  I  I SOTRM  -  NDAYI  8G,7C 
70  OR  E A  DY  =  -1 

CALDEF  -  0. : 
80  CC\T1NUC 

C  GET   THE   PIMONTHLY  FLOWS   AND  THE   PEAK  INFORMATION 
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CALL    GB  I MON 

I  TEMP   =  PEKDAT 

CALL  GPEAK  (IDATE1) 

c  store  the  final  information  and  write  the  record 

BLOCK (  1876)    =   VKTOT ( 1  I 
BLOCKI  1377)    =■  YRTOTI3) 
BL0CKI1878)   =  RECHRG  -  RCHRGO 
RCHOGO  =  P  ECHRG 
BLOCK ( 1 879  J   =   PKE  WEO  -  HEO 
HEO   =  PREWEQ 

r  NOTE   THAT  -PEKDAT-  HAS  REDEFINED  BY  SUBROUTINE   GPEAK,  SO 

C  -BLOCKII8P7)-   HAY   OR   HAY   NOT   BE    THE   SAME    AS    -BLOCK  I  1 67 3 1 - 

BLOCKI1837)    =  PEKOAT 

PEKOAT    =    I  TEMP 

8L0CK(188<)I    =  10ATE1 

CALL   PUTREC    116, BLOCK, 18891 

C  IF   THE   OUTPUT   IS  NOT   TO  BE   PRINTED,   GO  ON  TO  THE  NEXT  YEAR.    IF  IT 

C   IS,  OUTPUT  THE  COMPILED  RESULTS 

IFIPLNOPTI 11.EQ.0I   GO  TO  40 

YRT0TI2I    =  PPT1371I 

CHANGS    =   BLOCK (1878) 

CHANGW  =  BLOCKI 18791 

CALL  OUTPT 

GO  TO  40 

C  THE    NORMAL    SIMULATION    IS   COMPLETE,    SO   END  -SCRFIL- 

90  END  FILE  16 
100  CALL  EXTEND 
CALL  CORE  10) 

C  RETURN   TO   THE    PRIMARY  OVERLAY 

END 


Subroutine  EXTEND 


SUBROUTINE  EXTEND 

c  EXTEND   (OR  CONTRACT )  THE  DATA  BASE  ANO,   IF  SPECIFIED*   SAVE  IT 

COMMON  DAT  I  ME ( 2 ) , DECMAL , NRMANG, NSAVEO .NYE ARS , PLNOPT ( 1 9 ) , PLUN I T I  6  I , 
1  RECOVR.REGIONI 6) .REG0PTI5I , SAVE ,SEDRN2 .ME IGHT 
INTEGER  OA  TIME .PLNOPT , PLUNI T , RECOVR , REG  I  ON, REGOPT . S AVE*  S EDRN2 
COMMON/E/CON, 10(91 .NBLOCK.ORIGYR 
INTEGER  ORIGYR 

C0MM0N/UTILTY/BL0CKI1889) ,CH ANGR .CHANGW . DAT E ( 2 ) . DAT ES 1 4 ) ,L INES . 
1  NAME,NDAY,RCHRGC,ROI3T2),WE!372>,WEO,YEAR,YRTOTI3) 
INTEGER  DATE, DATES, YEAR 

DIMENSION  BIMNTHI6) ,ETO ( 372 ) , PPT  1 372 ) ,RAO( 372) ,TMAX I  372 ) ,TM INI  3721 
EQUIVALENCE   IBL0CKI2I ,TMAX(1 1 ) , I  BLOCK  1 3741 .TH INI  1 ) I , I  BLOCK! 746), 

1  PPT  111) , (BLOCK ( 1118) ,RADI1) ) , I  BLOCK ( 1490) ,ETO ( 1 ) ) , I  BLOCK  1 18641 , 

2  COM AX  I , (BLOCK! 1865) .VEGTYP) , ( BLOCK ( 1866 1 , TRSHLD) , (BLOCK! 18671, 

3  TMPMLT ),( BLOCK (  1868) , W! LTPT ) , ( BLOCK ( 187 1 ) .OCOMAX) , ( BLOCK!  1872 ) , 

4  ISOTRMI , [BLOCK  1  1873 ) .PEKDAT ) , I  BLOCK! 1880) ,B IMNTH! 1 ) ) , 

5  I  BLOCK!  1866) .PEAKWEI , I  BLOCK  1 1888 ) , PEAKS  0 1 
INTEGER  PEKDAT, VEGTYP 

CALL  CORE  1-1) 
MYEARS   =  NYEARS 
LINES. =  0 

C  IF  THE  FILE  IS  TO  BE  SAVED,  WRITE  THE  ID  RECORD 

IFISAVEI  10,33 
10  NSAVED  =  NSAVED  ♦  1 

DO  20  I  3  1,6 
20  101 1  I  =  PLUNITI I ) 

10(71  =  NYEARS 

I D I  8 )   =  DATIMEI1) 

1019)  =  DAT IME 1 2 ) 

CALL  PUTREC  (15,10,9) 

C  PREPARE  THE  FILES.     IF  OUTPUT  IS  WANTED,  PRINT  THE  HEADING 

30  REWIND  16 

REWIND  11 

GO  TO  60 

C  COPY  THE  ORIGINAL  DATA 

50  CALL  PUTREC   (11, BLOCK, 18891 

IF( SAVE. NE. 01  CALL  PUTREC   { 15 , BLOCK ,1889 ) 

YRNEXT  3  BLOCK(l) 

MYEARS  =  MYEARS  -  1 

IF(MYEARS)  110,110,60 
60  CALL  GETREC   ( 16 ,  BLOCK ,  1 889,  1  END ) 

IFIIENO)  70,50 

C  EXTEND  THE  OATA  BASE.     START  BY  COMPUTING  THE  NUMBER  OF  YEARS  IN 

c   THE  ORIGINAL   DATA  BASE  AND  THE   PRESENT  POSITION  OF   THE  SCRATCH 

C  FILE 

70  ORIGYR    =  NYEARS  -  MYEARS 

NBLOCK   =  ORIGYR  »  1 

C  DEFINE  THE  DEGREE  OF  THE  CONSTANT  TO  BE  USED  IN  THE  SELECTION 

C   PROCESS 

CON  =  13. 

IF(ORIGYR.GE.IO)  CON  =  CON  »  10. 
IF(ORIGYR.GE.IOO)   CON  =  CON  »  10. 
90  CALL  RANSEL 

YRNEXT    =   YRNEXT   ♦  1.0 

C  SIMULATE  THE   NORMAL  CONDITIONS 

CALL  SIMNRM 

IF(PLNOPTI2).EO.O)  GO  TO  100 
YRT0TI2)   =  PPTI371) 
C  HANGR   =   BL0CKI  1878I 
CHANGW   =  BL0CKI1879I 
YEAR   =  YRNEXT 

CALL  OUTPTl   ! INT ( BLOCK ( 1 ) ) ) 
100  TEMP   =  BLGCK I  1  I 

TEMP   =  BLOCK(l) 

BLOCK(l)    =  YRNEXT 

CALL  PUTREC  111, BLOCK, 18891 

IF(SAVE.NE.O)   CALL   PUTREC    ( 15 .BLOCK , 1689 ) 

BLOCKtl)    -  TEMP 

MYEARS    =   MYEARS   -  1 

IF(KYEARS)  110.110,90 
110  IF( SAVE. NE. 01   END  FILE  15 

CALL  CORE  (0) 
C  RETURN   TO   THE    MAIN  OVERLAY 

END 


Subroutine  GENDAT 


SURPOUTIME  GENDAT 


C  GENE "ATE   THE   DATA  FOR   THIS  SUBSTATION 

CpMP.0N/N/ACCUM,AIRTMC(4),ASPECT,CALDEF,C0VDEN,DECIDS(3l,DREADY, 

1  ENGRAL.ETDALY!  121  , FRAC TN , FRE WAT , I D ■ I H, I MN, I  MX , I P, IY , LASUSD, LAT, 

2  NO VSNO.ONTRES.PEKPPT, PHASE, POTENT! 24) .POTRAD, PPTNOW, PRE WEO, 

3  R AD SUB, RECHRG, SI MTH1 1 31 , SLOPE , SLPASP ( 24  I , SUMMER , TCDEFF , 

4  VARFMT(7|,VARIN(6) 

INTEGER   ASPECT, DREADY, PHASE, RADSUB, SLOPE, VARFMT 

C0MMCN/UTILTY/BL0CKI1889I , CHANGR .CHANGW , DAT E ( 2  I , DAT E S I  4 ) , L I NES , 
1  NAME, NDAY.RCHRGO.RO! 372 ), WE  I  372  I , WEO , YE AR , YRTOT ( 3  I 
INTEGER  DATE, DATES, YEAR 

DIMENSION  B1MNTHI6I ,ET0(372) . PP T ( 372  I , R AD ( 372 ) , TMAX (  372 ) , TM IN (  372  I 
EQUI VALENCE    ( BLOCK  I  2 1 , TMAX ( 1 ) I , I  BLOCK (3741  ,TMIN( I) ) , ( BLOCK  I  746  I , 

1  PPTI II  I , (BLOCK ( 1118), RAD (1)1 , ( BLOCK ( 1490) ,ETO( II), (BLOCK! 18641, 

2  COMIX) , I RLOCK!  1865) .VEGTYP) , (BLOC KI18 66  ), TRSHLD), I  BLOCK  (  18671  , 

3  TMPMLT I , I  BLOCK (1868) , W I LTPT ) , I  BLOCK ( 1 87 1 ) , DCDM AX ) , ( BLOCK ( 1872 ), 

4  ISOTRMI , (BLOCK!  1873) .PEKOAT) , I  BLOCK (  1880  I .BIMNTHI  1) ), 

5  I  BLOCK (  1886 ) , PE  AKWE ) , I  BLOCK ( 1686  I , PE AKR 0 ) 
INTEGER  PEKOAT, VEGTYP 

COMMON/WTPBAL/ALLOW,ETFROM,EVAPTR,GENRO,PEAKED,PRECIP,RADIN, 
1  RADLWN.RADSWN, TMPMAX , TMPM I N . WATR I N 
EQUIVALENCE    ( OATE I  1 ) , MONTH ) 
DIMENSION  DOFAC  T ( 26 ) 

OATA  DOFACT/  .23,  .35,   .45,  .51,   .56,   .59,   .62,   .64,   .655,  .67, 

1  .682,   .69,   .70,   .71,   .715,   .72,   .722,   .724,   .726,   .728,  .73, 

2  .734,   .738,   .742,   .746,  .75/ 
C  DEFINE   THE  UNADJUSTED  PRECIP 

PPMSTR   =  PPT(NDAY)   -  PPTNOW 
C  ADJUST  THE  TEMPERATURES 

TMPMAX   =   AIRTMC(l)    *    (TMAX(NDAY)    »   A I RTMC I  2 )  > 

TMPM I N  =  AIRTMC (3)   ♦   ITMIN(NDAY)   »  AIRTMCI4)) 

I F 1 T MPHAX   -   TMPM I N )  10,20,23 
10   TEMP    -  TMPMAX 

TMPMAX   =  THPMIN 

TMPM I N   =  TEMP 

C  GET   THE  DATE   ANO  POTENTIAL  RADIATION 

20  CALL   GDATE   I NOAY, DATE ) 

CALL  RADCMP   I IOATEI 1I«100)*DATE 121  I 

C  COMPUTE   THE   INCOMING  RADIATION  AT  THE   BASE  STATION  FROM  THE 

C   POTENTIAL  BY  THE  DEGREE-OAY  METHOD 

GO  TO  150, 50,50,50, 60, 70, 70, 70,60, 50, 50.50), MONTH 

C  OCTOBER  -  APRIL,   DEGREE   DAYS  =  .44  *  TEMPMAX  -  15.9   1*1.0  FOR 

C   SUBSCRIPTING) 

50  DO   =    13.44   *   TMPMAX )    -  14.9 

GO  TO  100 

C  MAY  ANO  SEPTEMBER,  DEGREE  DAYS  =  .53  •  TEMPMAX  -  19.5  1*1.0  FOR 

C   SUBSCRIPTING) 

60  00  =  10.53  •  TMPMAX )  -  18.5 
GO  TO  100 

C  JUNE,   JULY  AND  AUGUST,   DEGREE  DAYS  *   .63  »  TEMPMAX  -  24.1  1*1.0 

C   FOR  SUBSCRIPTING).  EXCEPT  ON  DAYS  WITH  PRECIP.     DURING  THESE 

C   MONTHS.  USE  A  CONSTANT  44  PERCENT  ON  PRECIP  DAYS 

70  IF(PPMSTR)  90.90,80 
80  RAOHRZ  =  POTRAD  *  0.44 

GO  TO  150 
90  00  =   10.63  •  TMPMAX)  -  23.1 

C  WATCH  FOR  THE  BOUNDARY  VALUES,  0.  AND  25.     (WITH  THE  1.0  ADDED 

C   ABOVE,  THE  SUBSCRIPTS  FOR  THE  TABULAR  VALUES  VARY  FROM  1  TO  26) 

100  IF(DD  -  1.0)  110,110,120 

C  USE  THE  FIRST  TABLE  VALUE   (NO  INTERPOLATION  IS  NECESSARY) 

110  RADHRZ  *  POTRAD  •  DDFACT 1 1 ) 
GO  TO  150 
*  120  IF ( DO  -  26.0)  140,130,130 

C  USE   THE  LAST  TABLE   VALUE   I  NO   INTERPOLATION   IS  NECESSARY ) 

130  RAOHRZ  =  POTRAD  •  DDFACT ( 26 ) 
GO  TO  150 

C  THE   SUBSCRIPT  IS   IN   THE  PROPER  RANGE.     OBTAIN  THE  INTERPOLATION 

C   FRACTION  AND  SUBSCRIPTS  THROUGH  TRUNCATION  OF  -DO- 

140  Jl  =  DD 

DDI  =  Jl 

J  =  Jl  ♦  1 

C  THE   TERM  IDO-DOll/1.0  IS  THE   INTERPOLATION  FRACTION 

RAOHRZ  =  POTRAD  •  (DDFACT! Jl)  ♦  I (DDFACT! J)  -  DDFACT! Jll)  *  I  DO  - 
1  DDI))) 

C  ADJUST   THE   POTENTIAL  EVAPOTRANSPIRATION  AS   COMPUTED  BY  THE  HAMON 

C   METHOD  FOR  AVAILABLE  RADIATION  AS  A  PERCENT  OF  POTENTIAL 

150  EVAPTR  =■  ETOALY I  MONTH)   «   (  RAOHRZ /POTRAD  I 
C  ADJUST  THE  RADIATION  AT  THE  BASE  STATION  FOR  SLOPE   ANO  ASPECT 

I   =  RADSUB  ♦  1 

IFII.GT.24)    I   *  1 

RAD1N  =  RADHRZ  *   ( SLPASP(RADSUB I  ♦   ((SLPASP(I)  -  SLPASPI RADSUB ) I 
I  «  FRACTNII 

C  ADJUST  THE   PRECIP  TO  ENSURE  REACHING  THE   PEAK  WATER  EQUIVALENT 

IFIPPMSTR)  160,160,170 
160  PRECIP  =  0.0 

GO  TO  200 
170  IFIP=KPPT  -  PPTNOW)  190.190,180 

160  PRECIP  »  PPMSTR  »  IIPEAKWE  -  PREWEQ )/ I PEKPPT  -  PPTNOW ) ) 
PEAKEO  -  0.0 
GO  TO  200 

C  AFTER   THE   PEAK ,   ADJUST   THE  BASE   STATION   PRECIP   B.Y  THE  CONSTANT 

C  SUMMER  FACTOR 

190   PRECIP    =   PPMSTR   *  SUMMER 
PEAKEO  =  1.0 

C  DO  NOT  ALLOW   INTERCEPTION   IN  JULY  ANO  AUGUST 

ALLOW  =  1.0 

IFINDAY.GE.280.AN0.NDAY.LE.341)   ALLOW  =  0.0 
200  IFIVEGTYP.NE.3.AND. VEGTYP.NE.4)   GO  TO  270 

C  CHECK  THE   DATE    (BETWEEN  APRIL   1   AND  OCTOBER   15,    IT   IS  POSSIBLE  TO 

C   HAVE  FOLIAGE.     BUT  DURING  THE  REMAINDER  OF   THE   YEAR .   IT  IS 

C   ASSUMED  THAT   THE   TREES  ARE  LEAFLESS) 

IFINDAY.GE.187.0R.NDAY.LE.15I  GO  TO  230 

C  THF   TREES   SHOULO  BE   LEAFLESS.      IF  THEY   ARE  NOT,    SWITCH  TO  THE 

£   LOWER  COVER  OENSITY 

210  IF  I VEGTYP  -  4)  220,270 
220  VEGTYP  =  4 
GO  TU  260 

C  THE   FOLIAGE   MAY  BE   PRESENT,   BUT   IF   THE   PACK  WATER  EQUIVALENT  IS 

C   MORE    THAN    5    INCHES,    THF    TREES   ARE    STILL    ASSUMEO  TO   BE  LEAFLESS 

230  IFIPREW50  -  5. J)  243,240.210 

C  THE   FOLIAGE   SHOULD  BE   PRESENT.      IF  NOT,    SWITCH  TO  THE  HIGHER  COVER 

C   DENSITY 

■240  I F I VEGTYP  -  31  250,270 
25C  VEGTYP  =  3 

26C  TCOEFF  =  SWITCH  ( TC OEF F , DEC  I  OS  I  1 ) I 
COVOEN  =  SWITCH  (C0V0EN,0ECI0S(2 I ) 
COMJX    =    SWITCH    (CDMAX.DECIDSI3) I 
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C  STORE    THESE    VALUES   FOB    OUTPUT    TO   THE    BASIC  FILE 

27C   TMAX(NOAY)    =  TMPHAX 
TMININDAY)    =  TMPMIN 
YRTGTt?)    =   YRTOTI2)   »  PRECIP 
PPTNOW   =  PPTINDAY) 
PPT(NOAY)    *   YRTOT 1 2 ) 
RADINOAYI    =  RADIN 
ETC(NOAY)    •  EVAPTR 
RETURN 
END 


Subroutine  GET1YR 


SUBROUTINE  GET1YR  (IEND) 

C  READ   THE    SPECIFIED  CONDITIONS   CARO   AND  THE   OAT  A 

COMMON   OATIMEI2I .OECMAL . NRMANG , NSAVED , NYEARS , PLNOPT ( 191 t PLUNITI6), 
I   RECOVR, REG  I  ONI  81 » REGOP  T ( 5 ) , S AVE . SEORN2 , HE ICHT 
INTEGER   DA  TIME, PLNOPT, PLUNIT, RECOVR, REG  I  ON, REGOPT.SAVE.SEDRN2 
COMMON/N/ACCUM, AIRTMC 14) , ASPECT , CALDEF , C OVDEN, DEC  I  OS  I  3  I . ORE ADY , 

1  ENGBAL.ETOALY! 12) , FRACTN, FREWAT , I D , I M, I MN, I  MX , I P> I Y , L ASUSO, L AT , 

2  NDYSNO.ONTRES, PEKPPT, PHASE . POTENT (24  I , PCTR ADt PPTNOH . PREHEO t 

3  RAOSUB,RECHRG,SIMTMl(3> ■ SLOPE . SLPASP I  24  I . SUMMER . TCOEFF , 

4  VARFMTI 71 , VARINI6) 

INTEGER   A  SPEC T, ORE ADY, PHASE.RAOSUB, SLOPE. VARFMT 

COMMON/UTILTY/BL0CKI1889) , CHANGR , CHANGW , DATE  I  2  I , DATE S ( 4  I , L I NE S . 
I   NAME, NDAY.RCHRGO.RO I  372  I ■ WE (372  I , WEO ■ YE AR , YRTOT I  3  I 
INTEGER  DATE .DATES, YEAR 

DIMENSION  BIMNTHI6)  ,E TO  I  372  I  , PPT  1 37 2  I , RA01 37 2  I , TMAX I  372  I . TM IN  I  372 ) 
EQUIVALENCE    I  BLOCK ( 2 ) .TMAX ( 1 ) I , I  BLOCK  I  374 ), TM INI  1)1. I  BLOCK  I  746), 

1  PPT  I  1  I  I , (BLOCK! 1118) , RAO  I  1 ) I ,( BLOCK ( 1 4901 ,ETO( II ) . ( BLOCK ( 1 864 1 . 

2  COM  AX  I , I  BLOCK ( 1 865 ) .VEGTYP) . (BLOCK  1 1866 ) .TRSHLD) , I  BLOCK ( 1867), 

3  THPMLT) , (BLOCK  1 1368) .WILTPT) , I  BLOCK ( 187 1 1 , OCOMAX ) , ( BLOCK  I  1872 ) , 

4  I SOTRM) , (BLOCK! 1873) .PEKDAT) . (BLOCK! 1880) , BIMNTHI 1 1  I, 

5  I  BLOCK  I  1886) .PEAKUEI , (BLOCK (1888  I , PE AKRO ) 
INTEGER  PEKDAT, VEGTYP 

DIMENSION  IDATESI6) 
READ  (191   NAME.PEAKWE. IDATES 
IFINAHE.NE.10HEND  OF  NAT )   GO  TO  10 
IENO  -  1 
RETURN 
10  IEND  =  0 

t  CONVERT  THE  DATES  TO  THE  PSEUOO- JULIAN  FORM     AND  STORE  THE  YEAR 

C   ALONG   WITH   THE   OECIMAL  ID 

PEKDAT  -  JWYOAT   I  I  DATE S 1 1  I , I  DATES  I  2 ) ) 

ISOTRM  -  JWYDAT  IIDATESI4I,IDATESI5I) 

YEAR  -  IDATESI6) 

BLOCK(l)   -  FLOAT ( YE  AR )   ♦  OECMAL 

C  READ  THE  DATA  AND  COMPARE  THE  YEARS 

CALL  READAT 

C  DEFINE  THE  ACCUMULATED  PRECIP  UP  TO  THE  OAY  OF  THE  PEAK 

20  IF! TMAX(PEKDAT-l)  ♦  1.E50)  40.30 
30  PEKDAT  =  PEKDAT  -  1 

GO  TO  20 
40  PEKPPT  -  PPTIPEKDAT-ll 

RETURN 

END 


Subroutine  GPARAM 


SUBROUTINE  GPARAM 

C  READ  THE   STATION  PARAMETERS  FROM  THE  PROOFREAD  FILE 

COMMON  OATIME I 2).DECMAL.NRHANG.NSAVED.NYEARS,PLN0PTI19),PLUNITI6I, 
1  RECOVR, REGION  18), RE G0PTI5). SAVE, SEDRN2.WEIGHT 
INTEGER  OAT  I  ME, PLNOPT, PLUNIT, RECOVR, REGI ON, REGOPT. SAVE. SE0RN2 
C0MM0N/N/ACCUM.AIRTMCI4) . ASPECT . CALDEF .C OVDEN. DEC  IDS  1 3 ) .ORE ADY. 

1  ENGBAL.ETOALYI 12 ) , FRACTN .FREWAT , ID. I N, I MN, I  MX, I P, I Y , L ASUSD , L AT , 

2  NDYSNO ,ONTRES, PEKPPT , PHASE , POTENT  124 ) .POTRAO.PPTNOW. PREWEQ. 

3  RADSUB.RECHRG.SIMTM1 (31 , SLOPE, SLPASP! 24  I .SUMMER, TCOEFF. 

4  VARFMT ( 7 ) .VARINI6) 

INTEGER  ASPECT, OREADY, PHASE ,RADSUB, SLOPE , VARFMT 

COMMON/UTILTY/BLOCKI188  9) , CH ANGR ,CHANGW , DATE  1 2 ) , DATES  14), LINES* 
1  NAME, NOAY.RCHRGO.RO 1 3 72) .WE  1372  I .WEO .YEAR, YRTOT! 3 ) 
INTEGER  DATE . DATES . YEAR 

DIMENSION  BIMNTHI 6) .ET0I372) , PPT (372) , RAD  1 372) .TMAX (372) .TMINI372I 
EQUIVALENCE   IBL0CKI2I ,TMAX(1 ) ) , I  BLOCK  1 374) .TMINI 1 ) ) , I  BLOCK  I  746). 

1  PPT  II ) I , I  BLOCK  I  111  8) ,RA0(1) ) ,( BLOCK! 1490),ET0( 1) ), I  BLOCK!  1864). 

2  CDMAXI , I  BLOCK!  1865) .VEGTYP ),( BLOCK! 1866  I , TRSHLD I , I  BLOCK ( 18671 , 

3  TMPMLTI , (BLOCK!  18681  , WI LTPT ) , I  BLOCK ( 1 87 1 1 , OCDMAX I , I  BLOCK ( 1872  I . 

4  ISOTRM) , (BLOCK (1873  I , PEKDAT ) , I  BLOCK (1880 1  , B IMNTHI 1) ), 

5  I  BLOCK (1886) .PEAKWE) , I  BLOCK ( 1888 ), PE AKRO) 
INTEGER  PEKDAT, VEGTYP 

READ   119)   TCOEFF, COVOEN , CDMAX , VEGTYP. TRSHLD, TMPMLT, WILTPT, DEC  I  OS. 
1  LAT, ASPECT, SLOPE , SI MTMl 12) . PREWEQ.RECHRG. ETOALY. AIRTMC. SUMMER 
£  IF   THE   TRANSMISSIVITY  COEFFICIENTS  ARE  NOT  SPECIFIED,   COMPUTE  THEM 

IFITCOEFF.LE.C.O)  TCOEFF  =  TC  ICOVDENI 

IFIDECIOSID.LE.O.O)  OECIOS(l)  "  TC  I0ECIDSI2II 

C  CONVERT  THE  PACK  TEMPERATURE  TO  CALORIE  DEFICIT  (AS  A  POSITIVE 

C   QUANTITY),   AND  DEFINE   THE  GROUMO  TEMPERATURE  FOR  THE  SIMULATION 

CALDEF  =  -SIMTM112)   •  PREWEQ  •  1.27 

SIMTM1!  1  I    =,   SIMTM1  (2) 

SIMTM1I3)   =  -1.5 
C-— — REAO  THE  RADIATION,   THEN  THE  VARIABLE  FORMAT 

READ   (19)   POTENT, SLPASP 

READ    119)    VARFMT ,NF ILE • IM, ID, I Y, IMX, IMN, IP 

C  POSITION  THE   UNEOl TED  FILE  AND  READ  THE   FIRST  CARD 

CALL    SKPFIL  (NFILE) 
READ    ! 10, VARFMT)  VARIN 

RETURN  " 
END 


COMMON/UTILTY/BLOCK!  18  89) , CHANGR , CHANGW.  OAT E  I  2 1 ,04TES( * ) .LINES, 
I   NAME.NDAY.RCHRGC ,R0( 372 ) , WE  I  372  I  , WEO , YE AR , YRTOT I  3  I 
INTEGER    DATE , DATES, YEAR 

DIMENSION  BIMNTHI 6)  , ETO I  372), PPT ( 372), RAOi 372), TMAX (372), TMINI  372) 
EOUI VALENCE    (BL0CK(2I , TMAX ( I  I ) , ( BLOCK ( 374 1  , TM I N ( I  I ), ( BLOCK!  746). 

1  PPT  I  1  I  I , (BLOCK!  lll«) ,RAO( 1 )  I , ( BLOCK  I  1 490 ) ,ETD( 1  I  I , I  BLOCK! 18641, 

2  COM  AX)  ,  I  BLOCK  I  1865) , VEGT YP I , I  BLOCK  1 1 366  I , TR SHLO I . I BL OCK I  1867 ) , 

3  TMPfLTI , (BLOCK! 1863  1 .WILTPT) .(BLOCK! 1871). DCOMAX). I  BLOCK! 18721, 

4  I SOTRK) , I  BLOCK!  18731  .PEKDAT) , I  BLOCK  I  1 880 ) , B I MNTHI 111, 

5  I  BLOCK  I  1386) , PEAKWE )  , I  BLOCK  I  1 888  I , PE AKRO I 
INTEGER    PEKDAT, VEGTYP 

INTEGER   YRF ROM 

C  CHECK  THE   LINE  COUNTER 

IFILINESI  10,10,20 
10  WRITE    16,910)    REGION, OATIME, PLUNIT 
910   FORMATI»l»8A13,32X2A10/lX6A10,45X»EXTENDEn  NATURAL  CONDITIONS*/ 
1  »0  • 

1     «YFAR       -  -  -  -B I  MONTHLY  GENERATED  RUNOFF-  -  --  ------ 

2YEARLY  ------  9/30   -   PEAK   ------  -•/ 


3  •  APRIL       MAY         MAY         JUNE       JUNE       JULY  GEN 

4  CHANGE   CHANGE        RECH  7-DAV*/ 

5  •  (FROM)' 

5  •  16-30       1-15     16-31       1-15     16-30       1-15  RO  PPT 

6  El      RECH      W.E.         REO      W.E.       DATE     GENRO  DATES*/) 
LINES  =  50 

C  PRINT  THE  LINE 

20   WRITE    16,920)    YRFROM, YEAR, BIMNTH, YRTOT, CHANGR , CHANGW , RCHRGO , 
1  PEAKWE, DATE, PEAKRO, DATES 
920  FORMAT  I »   I * 1 3 ,« ) *2XI 3 , 1 XI 3F7 . 2 , 2X12 .*/«! 2, F7 .2, 2 1 2X I Z. */* IZ ) I 
LINES  =  LINES  -  1 
RETURN 
END 


Subroutine  RADCMP 


SUBROUTINE  RADCMP  IMMDOI 

C  COHPUTE   THE   POTENTIAL  RADIATION  AT  THE  BASE  STATION 

COMHON/N/ACCUM, AIRTMC 14) , ASPECT , CALDEF , COVOEN, DEC  IDS  I  3  I , ORE ADY, 

1  ENGBAL,ETDALYI12) , FRACTN, FREWAT , I D, I M, I MN, IMX. IP, I Y, L ASUSD. LAT, 

2  NDY SNO.ONTRES, PEKPPT. PHASE. POTENT! 24 ) , POTRAO.PPTNOW, PREWEQ. 

3  RAOSUB.RECHRG, SINTM1 (3) , SLOPE , SLPASP I  24 ) , SUMMER , TCOEFF , 

4  VARFMTI 7) .VARINI6) 

INTEGER  ASPECT, ORE ADY, PHASE.RAOSUB. SLOPE. VARFMT 

COMMON/UTILTY/BLOCK 1 1889), CHANGR, CHANGW, DATE  I  2  I, DATES  I  4 1, LINES. 
1  NAME, NOAY, RCHRGO, RO I  372) , WE  1 372  I , WEO , YE AR .YRTOT I  3  I 
INTEGER  DATE, DATES, YEAR 

DIMENSION  BIMNTHI 6) ,E TO  1 372 1  , PPT  1 372 ) , RAD! 372 ) , TMAX I  372 1 ,TM INI  372) 
EQUIVALENCE   I  BLOCK  I  2  I , TMAX 1 1 ) ) , ( BLOCK! 3741 , TMINI I ) ) , I  BLOCK  I  7461 • 

1  PPT  1 1 ) ) , I  BLOCK (1118) ,RA0I1) I , I  BLOCK  1 1490) , ETO 1 1 ) ) , I  BLOCK! 1864) , 

2  CDMAX) , (BLOCK  1 1865) .VEGTYP) , (BLOCK  1 1866 ). TRSHLD) . I  BLOCK  I  1867), 

3  TMPMLTI , (BL0CKI186BI .WILTPT) .(BLOCK  1 1871 ), DCOMAX ) , I  BLOCK  II B7Z I, 

4  ISOTRM) , I  BLOCK  I  1873) .PEKDAT), I  BLOCK  I  1880), BIMNTHI II ), 

5  (BLOCK! 1B86) .PEAKWE) . IBLOCKI1888) .PEAKRO) 
INTEGER  PEKDAT, VEGTYP 

DIMENSION  BETWENI24) .NDATEI24) 

DATA  BETWEN/13. *  15..   13.,   15.,   14.,   14.,  15.,   14.,   IS.,  14., 

1  21.,   20.,   15.,   14.,  15.,  15.,  14.,  15.,  14..  14.,   14.,   14.,  19., 

2  19./ 

DATA  NDATE /  110,123,207,220,307,321.404,419,503,518,601,622,712, 
1  727,810,825,909,92  3,1008,1022, 1105,1119,1203, 1222/ 

C  PLACE  THIS  OATE  WITH  RESPECT  TO  THE  TABLES 

DO  10  I   =  1,24 
I F I NDATE ! I )  -  MMOO)  10,80,20 
10  CONTINUE 

C  A  NORMAL  TERMINATION  OF  THE  00  LOOP  MEANS  THAT  THIS  DATE  FALLS 

C   BETWEEN  12/23  AND  12/31,   INCLUSIVE.     USING  THE  ARRAY  IN  CIRCULAR 

C   FASHION,   1/10  (SUBSCRIPT  1)   IS  THE  CONTROLLING  DATE 

I  «  1 

GO  TO  30 

C  THIS  DATE  FALLS  BETWEEN  THE  ONES  AT  LOCATIONS  I  AND  1-1.     IF  I  IS 

C   l,   USE  24  FOR  1-1  SINCE  THE  ARRAY  IS  CIRCULAR 

20  RA0SU8  =1-1 

IFIRAOSUB)  30,30,40 

30  RAOSUB  =  24 

C — -—OBTAIN  THE   INTERPOLATION  FRACTION.     START  BY  DETERMINING  IF 

C   THIS  DATE  FALLS   IN  THE   SAME  MONTH  AS   THAT  AT  LOCATION   I  OR  1-1 

40  IFI0ATEI1)  -  INOATEIRADSUBI/100) )  60,50,60 

c  IT  IS  THE  SAME  AS  1-1  AND  IT  IS  LARGER,   SO  SUBTRACT  THE  1-1  DATE 

C   TO  OBTAIN   THE  NUMBER  OF   DAYS  TO  BE  USEO  FOR  INTERPOLATING 

50  DAYS  =  MMOD  -  NDATE (RADSUB) 
GO  TO  70 

C  IT   IS  THE   SAME   AS   I,   BUT   IT   IS  SMALLER,   SO  SUBTRACT   IT   FROM  THE  I 

C   DATE.      THEM   SUBTRACT  THE  RESULT  FROM  THE  DAYS   BETWEEN   I   ANO  1-1 

C   TO  OBTAIN  THE   NUMBER  OF  DAYS  TO  BE  USED  FOR  INTERPOLATING 

60  DAYS  =  NDATE I  I )   -  MHDD 

DAYS   =  BETWEN(RAOSUB)   -  DAYS 

C  COMPUTE   THE   INTERPOLATION  FRACTION 

TO  FRACTN  =  DAYS/BET WEN (RADSUB) 

POTRAD  =  POTENTIRADSUB)   ♦    IPOTENTII)   -  POTENT! RAOSUB ) I   •  FRACTN 
RETURN 

C  THIS  DATE   IS   IN  THE   TABLE  -  NO   INTERPOLATION   IS  NECESSARY 

80  FRACTN   =  0.0 
RADSUB  =  I 
POTF  AD   =  POTENT! 1  I 
RETURN 
END 


Subroutine  RANSEL 


Subroutine  0UTPT1 


SUBROUTINE   0UTPT1  (YRFROM) 
—OUTPUT   THE  COMPILEO  RESULTS  AND  WRITE  THE  BASIC   DATA  ON  THE  FILE 
COMMON   OATIME (2 ) , DEC HAL, NRMANG, NSAVED, NYE ARS, PLNOPT I  1 9 ) , PLUN I T I  6  I , 
1  RECOVR, REGION (3) .RFG0PT15) , S AVE , SE DRN2 , WE  I GHT 
INTEGER  DA TI ME .PLNOPT, PLUM  T .RECOVR, REGI ON, REGOPT, SAVE, SE0RN2 


SUBROUTINE  RA'.SEL 

C  RANDOMLY   SELECT   THE    NEXT   YEAR   FROM   THE   ORIGINAL    OATA  BASE 

COMMOU   OATIME (2  I ■ DECMAL . NRMANG . NSAVED . NYE AR S . PLNOPT ( 191 . PLUN I T ( 6  I . 
1  RECOVR. REGION  I  8  I .REGOPT ( 5  I . S AVE . SE DRN2 , WF I GHT 
INTEGER    DATIKe,PLNOPT,PLUNI T, RECOVR, REGI ON, REGOPT, SAVE, SE OR N2 
COMMON/E/CON, 10 191 , NBLOCK , OR  I GYR 
INTCGER  OPIGYR 

COMMON/UTILTY/BLOCK I  1889)  , CH ANGR ,CH 4NGW , D AT E I  2  I ,DATES!4), LINES, 
1  NAME, NOAY, RCHRGC,RO(3721  ,WE I  372 ) , WEO, YEAR, YRTOT! 3) 
INTEGER  DATE , DATES, YEAR 
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DIFFUSION  BIMNTH(6I,ET0(372),PPT(372). RAD  (3721 , TMAX ( 372 ) , TM I N( 3721 
EOUIVALFNCE    ( FLOCK ( 2 )  t  TMAX  ( 1  )  )  i  (  BLOCK  (  374  I  ,  I H  I  1 1  1  I  )  ,  I  BLOCK  I  746), 

1  PPT ( 1 ) I , (OLOCK I  111 B I ,PAD I  1 i  I  ,  I  BLOCK ( 1490) t  E  TO  (  1  I ) , ( BLOCK ( 1864) . 

2  CO* Ml , (BLOCK! IB65I .VEGTYP) ,( BLOCK ( 1 B66 ). TRSHLO )■( BLOCK  I  18671  , 

3  TMP»1LTI  ,  (BLOCK!  186  8),WILTPT),(8L0CK(1371I  .DCDMAX)  ,  (BLOCK!  18  721  , 

4  I  SO  TP M)  ,  (BLOCK! 1873)  .PEKDAT)  ,( BLOCK (  1880 ) , BIMNTHI 1) >, 

5  IBL0CKI18B61  ,  PE  AKWE  )  ,  (  BLOC  K  (  )  888  I  ,  PE  AKRO  I 
1NTEGFR   PEKOAT, VEGTYP 

C  GET   A  RANDO"  NUMBER  BETWEEN  1  AND  -ORIGYR-   (SUBROUTINE  RN2 

C   RETURNS  A  REAL   VALUE   BETWEEN  0   AND  1) 

10  CALL   RN2    I SEDRN2, RANDOM) 
N   =    RANDOM   *  CON 

IF! 1 .GT .N.OR .N.GT.ORIGYR )   GO  TO  10 

C  COMPARE    THIS   NUMBER    WITH    THE   CURRENT    BLOCK.      IF   THEY    ARE   THE  SAME, 

c   NO  FURTHER  READING   IS  NECESSARY.      IF  THE  CURRENT  BLOCK  NUMBER  IS 

c   LARGER,   THE  FILE   MUST  BE   REWOUND  BEFORE  THE   SEARCH  BEGINS 

IFIN  -  MBLOCK )  20,40,30 
20  REWIND  16 

NBLOCK  =  0 

C  BYPASS   THE    BLOCKS  UNTIL   THE    SPECIFIED  NUMBER    IS  FOUND 

30  CALL   GETREC    (16, BLOCK, 1889, IEND) 
NBLOCK  =  NBLOCK  +  1 
IFIN  -  NBLOCK)  30,40 
40  RETURN 
END 


Subroutine  READ  AT 


SUBROUTINE   R E AD AT 

C  READ  THE  YEAR  OF  DATA  AND  STORE  IT 

COMMON/N/ACCUM.AIRTMC (4) , AS PECT , C ALDEF , C OVDEN, DEC  I DS ( 3 ) , ORE ADY , 

1  ENG8AL,ETDALY(12) , FRAC TN , FRE WAT , I D , I M, I MN , I  MX , I P, I Y , L ASUSD, L AT, 

2  NDY SNO.ONTRES.PEKPPT, PHASE, POTENT (24  I , POTRAD, PPTNOW , PREWEQ, 

3  RADSUB.RECHRG, SI MTM1 (3  I , SLOPE , SLPASP ( 24 ) , SUMMER , TCOEFF , 

4  VARFMTI7) , VARINI6) 

INTEGER  ASPECT, DREADY, PHASE, RADSUB, SLOPE .VARFMT 

COMMON/UTILTY/BLOCK (1889) , CH ANGR .CHANGW, DATE ( 2 ) , DATES ( 4 ) , L I NES , 
1  NAME, NDAY.RCHRGO.RO I  3 72) , WE (372) , WEO , YE »R , YRTOT I  3 ) 
INTEGER   DATE, OATES, YEAR 

DIMENSION  BIMNTHI6) ,ET0(372) , PPT ( 372 ) , RAO( 372  I , TMAX ( 372 ) , TM INI  372) 
EQUIVALENCE    (BLOCK! 2), TMAX! 1  I  I , I  BLOCK  1 374 ) , TMI N I  1 ) ) , I  BLOCK ( 746 ) , 

1  PPT  I  1  I ) , I  BLOCK  I  111 B) .RADII) ) ,( BLOCK  1 1490 >, ETO ( 1 )>, I  BLOCK ( 1864 > , 

2  CDMAX) , I  BLOCK (1865) .VEGTYP) , I  BLOCK  1 1 866  I , TRSHLO 1 , I  BLOCK  I  1867), 

3  TMPMLTI , (BLOCK  1 1868 1  .WILTPT) , (BLOCK! 1871) .DCDMAX), (BLOCK! 1872), 

4  ISOTRMI , I  BLOCK  I  18731  .PEKOAT ) , ( BLOCK  1 1880 1 . B I MNTHI 1  I ), 

5  I  BLOCK  I  1886) ,PE AKWE ) , I  BLOC K 1 1 8 88 ) .PEAKRO) 
INTEGER   PEKDAT, VEGTYP 

DATA  MONTH/0/ 

IFIMONTH.EO. -9999991    GO   TO  20 

C  FINO  THE  FIRST  CARD  FOR  THIS  YEAR 

10   MONTH   =  VARINIIM) 
I  YEAR  =  VARINIIY) 

IF  I  I IYEAR-U.EQ. YEAR. AND. MONTH. GE . 101 .OR. 1 1 YE AR.EO. YEAR. AND. MONTH. 
1  LE.9) )   GO  TO  30 
READ    ( 10 , VARFMT )  VARIN 
IFIE0FI101)  20,10 
20  WRITE   (6,910)  YEAR 
910  FORMAT (*0UNABLE   TO  FIND  YEAR*I4,»  ON  -UNEDIT-.     JOB  ABORTED* ) 
CALL  ABORT 

C  STORE   THE   LARGE   VALUE   IN  THE   MAXIMUM  TEMPERATURE  SO  MISSING  OR 

C   NONEXISTENT  DAYS   (FEB  30)   CAN  BE  DETECTED 

30  DO  40   I   =  1,372 
40  TMAX I  I )   =  -1.E50 

C  CONVERT  THE  DATE   TO  THE   PS EUDO- JUL  I  AN  FORM  AND  STORE  THE  DRIVING 

C   VARIABLES 

50  I  DAY  =  VARIN(IO) 

J    =  JWYDATIMONTH.IOAY) 
TMAXIJ)   =  VARINIIMX) 
TMINIJ)    =   VAR I N ( I MN ) 
PPT! J)    =   VARINI IP) 

C  READ   THE  NEXT  CARD  AND   IF   THE  WATER  YEAR  DOES  NOT  CHANGE,   GO  BACK 

C  TO   STORE  IT 

READ    (10, VARFMT)  VARIN 

IFIEOF(IO))  70.60 
60  MONTH   -  VARINIIM) 

IYEAR    =  VARINIIY) 

IF! ( IYEAR»1.EO.YEAR.ANO.MONTH.GE.10I .OR. ( I YE AR . EO. YEAR . AND . MONTH . 
1   LE.9) )   GO  TO  50 
GO  TO  80 
70  MONTH  =  -999999 

C  THIS  YEAR  IS  COMPLETE  -  ACCUMULATE  THE  PRECIP 

80  ACCUM  =  0.0 
NDAY   =  0 
DO   100   I   =  1,372 
IF(TMAXII)   »   1.E50)  90,100 
90  ACCUM  =  ACCUM  ♦  PPTII) 
PPTI  I  1    =  ACCUM 
NDAY   =   NDAY   *  1 
100  CONTINUE 

IFINDAY.GE.364.AN0.NDAY.LE.367)  RETURN 
WRIT?    16. 920)    YEAR, NDAY 
920   FORMAT!*      NOTE    -   YEAR*I4,*   HAS*I4,«  DAYS') 
RETURN 
ENO 


Subroutine  SIMNRM 


SUBROUTINE  SIMNRM 

C  PERFORM  THE  NORMAL  SIMULATION  FOR   A  YEAR  CREATEO  OURING  THE 

C   EXTENSION  OF   THE  OATA  BASE 

COMMON  0ATIMEI2) , DECMAL , NR WANG, *SA VEO, N YE ARS .PLNOPT 1 19 1 .PLUNITI6) , 
1  RECOVR, REGION  I  8) , REGOPT 15), SAVE, SEDRN2, HEIGHT 

INTEGER  OATI ME, PLNOPT, PL UNIT, RECOVR .REGION, REGOPT, SAVE ,SEDRN2 

COMMON/N/ACCUM, AIRTMCI4) .ASPECT ,CALOEF , COV CEN, OECI OS  I  3  I . OREADY , 

1  ENGBAL.ETOALY (12) , FRACT N, FRE WAT , 10, IM , IKN , IMX.I P, I Y , L ASUSO, L A T t 

2  NO YSNO, ONTRES ,P£KPPT, PHASE, POTENT (24 ) , POTR AO, PPTNOW, PRE HEQ, 

3  RA0SU8,RECHRG,SIMTM1(3) ,SLO PE , SLPASP ( 24 ), SUMMER , TCOEFF, 

4  VARFMT(7),VARIN(6) 

INTEGER   ASPECT .ORE AOY, PHASE, RAOSUB, SLOPE, VARFMT 


COMMON/ TIME/CANREF, CDMAX 2, CONAV 

COMMON/UTILTY/BLOCK 1 1889) , CH ANGR , CHANG N, OATE (2) .DATES (4) .LINES, 
1  NAME, NDAY.RCHRGO.RO (372), HE (37 2), WEO, YEAR, YRTOT (3) 
INTEGER  DATE, OATES, YEAR 

OIHENSION  BIHNTH (6) ,ETO I  372 ) , PP T 1 3 72 ) , RAO  I  372  I , TMAX I  372 ) , T MIN (372 1 
EQUIVALENCE   I  BLOCK  12) ,THAX (1 ) ) , (BLOCK  I  3741  .TMINIl) ) , I  BLOCK  1 746 )  , 

1  PPT(l) ), (BLOCK (1118), RADII) ), (BLOCK  1149  01  ,ET0I1>> , I  BLOCK (1864) , 

2  CDMAX ) , I  BLOCK  1 1865), VEGTYP) , I BLCCK II 8 €6) .TRSHLO) , I  BLOCK  11867) , 

3  TMPHLT) , IBL0CKI1S68) .WILTPT) ■ I  BLOCK  II 671) , QCOMAX) , I  BLOCK  1 1872 ) , 

4  ISOTRM) .(BLOCK  1 1873), PEKOAT) , I  BLOCK  1 1 880 > ,BIMNTH(1) )  , 

5  I  BLOCK  1 1886)  ,PEAKHE), (BLOCK  11868) , PEAKRO) 
INTEGER  PEKDAT , VEGTYP 

COMMON/ WTRBAL/ ALLOH, ETFR  OM, E  VAP  TP.GENRO , PEAKED  ,  PPECIP,  RAOIN, 
1  RADLWN,RAOSWN,TMPHAX,TMPMIN,NATRIN 
C  STORE  THE  INITIAL  CONDITIONS   AND  ZERO  THE  ACCUMULATORS 

BL0CKU874)  =  PREWEQ 

BL0CKI1875)  =  RECHRG 

YRTOT(l)  =  0.0 

YRT0TI3I  -  0.0 

OREAOV  =  0 

PPTNOW  -  0.0 

PEAKED  =  0.0 

DO  30  NDAY  =  1,372 

IF  I T MA x ( NDAY)    t  1.E50)  10,30 

C  OEFINE  THE  DRIVING  VARIABLES 

10  TMPMAX  =  TMAX ( NO AY ) 

TMPMIN  =   TMIN ( NDAY) 

PRECIP  -  PPTINOAYI  -  PPTNOW 

PPTNOW   =  PPT(NOAY) 

EVAPTR  =  ETOINDAYI 

RAOIN  =  RAOINOAY) 
C  DO  NOT  ALLOW  INTERCEPTION  IN  JULY  AND  AUGUST 

ALLOW  -  1.0 

IFINOAY.GE. 280. AND. NDAY. LE. 341)   ALLOW  =  0.0 
IF (NOAV .EQ.PEKDAT)   PEAKED  =  1.0 

C  WATCH  FOR  DECIDUOUS  FOREST  AND  THEIR  CHANGE  OF  SEASONS 

IF  I  VEGTYP. EQ. 3 .OR. VEGTYP .EQ. 4)  GO  TO  40 
IS  CONTINUE 

C  MAKE  THE  PASS  THROUGH  THE  WATER  BALANCE  ROUTINES 

CALL  WAT BAL  ICALDEF, CDMAX, CO VOEN«0READY,ENGBAL«FREMAT*LASUSD, 

1  NDVSNO,  ONTRES,  PHASE,  PRE  WEO.  RECHRG,  SIMTH1 1 L), SIMTH.lt  2)  .SIMTMll  31  , 

2  TCOEFF, TMPMLT , TRSHLO, VEGTYP , WILTPT) 
C  STORE  THESE  RESULTS 

WE (NDAY)  =  PREWEQ 

RO(NOAY)   =  GENRO 

YRTOT (1)   •  YRTOT II )   •  GENRO 

YRTOT 13)  =  YRTOT (3)  *  EVAPTR 
C  NATCH  FOR  THE   MANDATORY  ISOTHERMAL  DATE 

IFIISOTRM  -  NDAY)  30,20 
20    OREADY   -  -1 

CALDEF  =0.0 
30  CONTINUE 

C  GET  THE  BIMONTHLY  FLOWS  AND  THE  PEAK  INFORMATION 

CALL  GBIHON 

ITEHP  *  PEKOAT 

CALL  GPEAKIIDATE1) 
C  STORE  THE  FINAL  INFORMATION 

BL0CKI1876)  *  YRTOTCll 

8L0CKI1677)  =   YRTOT (3) 

BL0CKI1876)  ■  RECHRG  -  RCHRGO 

RCHRGO  =  RECHRG 

BL0CKIia79>  =  PREWEQ  -  WEO 

NEO  »  PREWEQ 

C  NOTE  THAT  -PEKDAT-  MAS  REDEFINED  BY  SUBROUTINE  GPEAK,  SO 

C  8L0CKI1887)-  WAV  OR  HAY  NOT  BE  THE  SAME  AS  -BLOCK  1 1873 ) - 

BL0CKU88?)   =  PEKOAT 

PEKDAT  =  ITEHP 

BL0CKU889)   *  IDATE1 

RETURN 

C  WATCH  FOR  THE  CHANGE  OF  SEASONS  FOR  OECIOUOUS  FORESTS 

40  CONTINUE 

c  CHECK  THE  DATE   (BETWEEN  APRIL  1  AND  OCTOBER  15,  IT  IS  POSSIBLE  TC 

C   HAVE  FOLIAGE.     BUT  OURING  THE  REHAINDER  OF  THE  YEAR,  IT  IS 

C   ASSUNED  THAT  THE  TREES  ARE  LEAFLESS) 

IFINOAY.GE. 187. OR. NDAY. LE. IS)  GO  TO  230 

c  THE  TREES  SHOULD  BE  LEAFLESS.     IF  THEY  ARE  NOT,  SWITCH  TO  THE 

C   LONER  COVER  DENSITY 

210  IFIVEGTYP  -  4)  220,270 
220  VEGTYP  =  4 
GO  TO  260 

C  THE  FOLIAGE  HAY  BE  PRESENT,  BUT  IF  THE  PACK  WATER  EQUIVALENT  IS 

C   MORE  THAN  S  INCHES,  THE  TREES  ARE  STILL  ASSUNED  TO  BE  LEAFLESS 

230  IFIPRENEQ  -  5.0)  240,240,210 

C  THE  FOLIAGE  SHOULD  BE  PRESENT.     IF  NOT,  SWITCH  TO  THE  HIGHER  COVER 

C   OENSITY 

240  IFIVEGTYP  -  3)  250,270 

250  VEGTYP  =  3 

260  TCOEFF  =  SWITCH  (TCOEFF, OECIOSID) 

COVDEH  =  SWITCH   (COVDEN, OECI OS  1 2 ) ) 

COHAX  =  SWITCH   ICDMAX, DECIOS (3) I 
270  CONTINUE 

GO  TO  IS 

ENO 


Subroutine  SKPFIL 


SUBROUTINE   SKPFIL  (NFILE) 

C  SKIP   FILES  ON  THE  UNEO I  TED  OATA  FILE 

REWIND  10 
MFILE    =   NFILF   -  1 
IF (NFILE )  50,50,10 
10  00  40   I   =   1, MFILE 
READ  (10,910) 
910  FORMAT! IX) 

C  AN  END  OF  FILE   ON  THE  FIRST  READ   INDICATES   AN   END  OF  INFORMATION 

IFIEOFIIOII  20.30 
20  J  =  I  -  I 

W1ITE   16,920)   J, NFILE 
920  F0RMATI«0THER=   ARE   0NLY«I3,*  FILES  ON  -UNEDIT-  BUT   ACCORDING  TO  TH 
IE    VARIABLE    FORMAT   CARD ,    THE    DATA   IS   ON   FILE«I3,*   -   JOB  ABORTED*) 
CALL  ABORT 

C  BYPASS  THE   REMAINOER  OF  THE  FILE 

30  READ  (10,910) 
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IFIEOFI 1CI I  40,30 
40  CONTINUE 
50  RETURN 

END 


Subroutine  TITLEN 


SUBROUTINE  TITLEN 

C  PRINT    THE    TITLE  SHEET 

COMMON   OA T I  ME  12  I , OECMAL, NRHANG.NSAVED, NY F ARS, PLNOPT I  19 1 , PLUN I T I  6  I , 
1    RECOVR, REGION (8) t REGOP  T ( 5 )  . SA VE . S E0RN2 , ME  I GHT 
INTEGER  OAT  I  ME .PLNOPT , PLUN IT .RECOVR .REGION, PEGOPT, SAVE. SEDRN2 
COHMON/N/ACCUM.AIRTMC (41 , ASP ECT , CALDEF , C OVDEN, DEC  I DS I  3 1 , ORE AOY , 

1  ENGBAL , ETDALY 1 12  I  ■ FR AC TN , FREWAT . 1 0 , I M , 1 MN, I  MX , I P , 1 Y , L ASUSD, LAT , 

2  NOV SNO.ONTRES.PEKPPT, PHASE. POTENT (24  I . POTR AO, PP TNOW , PREWEO . 

3  RA0SU8,RECHRG,SIMTMII3I  ,  S  LOPE  ,  SL  PAS  P  (  24  I  ,  SUMMER  ,  TCOEFF  , 

4  VARFMTI7I ,VARIN!6) 

INTEGER   ASPECT, DREAOV, PHASE, RADSUB, SLOPE, VARFMT 

COMMON/UTI LTT /BLOCK (  1889) • CHANGR • CHANGU , DATE (21, DAT E S I  4  I ■ L I NES , 
1   NAME, NOAY.RCHRGO.RO (372  I . WE  I  372  I . WEO , YE  A R , YRTOT I  3 1 
INTEGER   OATE, DATES. YEAR 

01  MENS  I  ON  BIMNTHI6)  , E TO  I  372  I  , PPT  I  372  I , R AD( 37 2  I , TMAX (  372  I , TH [N (  372  I 
EQUIVALENCE    (BLOCK! 21 , TMAX ( 1 M , ( BLOCK ( 374 1  , TMI N I  1)1, (BLOCK! 7461. 

1  PPTIl I  I , I  BLOCK  I  1118) ,RAO( 1  I ) .( BLOCK  I  1490 1 . ETO ( 1  I ) . ( BLOCK ( 1864  I , 

2  COM AX  I , (BLOCK! 1 865 ) , VEGT YP I , ( BLOCK ( 1 866 ) . TRSHLO I . I  BLOCK ( 1B67I, 

3  TMPMLT) , (BLOCK!  1868  I .W1LTPT) , ( BLOCK ( 187 1 1 , OCDM AX  I , I  BLOCK (  1 872 ) , 

4  ISOTRMI , (BLOCK!  18731 .PEKDAT) . I  BLOCK (  1880  I , 8 1 MNTH ( 1 1 > , 

5  I  BLOCK!  18861  .PEAKHE I . ( BLOC K ( 1 888 ) . PE  AKROI 
INTEGER  PEKDAT, VEGTYP 

INTEGER    TABLEK  131  ,TABLE2(  131 

DATA  TABLE 1/6HJUN  22.6HJUN  1  .6HMAY  18.6HMAY  3  * 6HAPR  19.6HAPR  4  , 
1   6HMAR    21.6HMAR    7    .6HFE8   20.6HFE8  7    . 6H J AN   23.6HJAN   10, 6H  / 

OATA    TABLE  2/6H  >6H JUL   12.6HJUL   27.6HAUG   10.6HAUG  25.6HSEP   9  . 

1   6HSEP  23.6H0CT  8   . 6H0CT  22.6HN0V  5   ,6HN0V   19.6HDEC   3  . 6HDEC  22/ 
WRITE   (6,9101  PLUNIT.DATIME 
910  FORMAT(*1*6A10.52X2A10/115X*NATURAL  CONDITIONS*) 
TMPMLF   =   ITMPMLT  «   1.8)   *  32. 

WRITE   (6,9201   TCOEFF, COVDEN, CDMAX , VEGTYP, TRSHLD, TMPMLF, WILTPT 
920  FORMAT(*0SUBSTATION  CONSTANTS*/*  TRANSM I SS I V I T Y  COEFF*10XF 10 . 2/ 

1  •  COVER  DENSITY  *10XF10.2/*  MAXIMUM  COVER  DEN  *10XF10.2/ 

2  •  VEGETATION  TYPE  «10XI10     /*  REFLECT  IV ITY  THRSHLD*10XF10.2/ 

3  •  MELT  THRESHOLD  *10XF10.2/*  WILTING  POINT  *10XF10.2I 
IFIVEGTYP.E0.3)  WRITE   (6,930)  DECIOS 

930  FORMAT!*  DECIDUOUS  WINTER   TC  «10XF10.2/ 

1  «  OECIOUOUS  WINTER  CO  *10XF10.2/*  DECIDUOUS  WNTR  CDMAX«10XF10.2) 
WRITE    (6,9401    SIMTM1 12), PREWEO, RECHRG 
940  FORMAT(*OINITIAL  CONDITIONS*/ 

1  «  AVERAGE  PACK  TEMP .     *10XF10.2/«  PACK  WATER  EOUIV.  *10XF10.2/ 

2  «  RECHARGE  REQUIREMENT*10XFI0.2) 

WRITE    (6,950)   LAT, ASPECT, SLOPE, ITABLE1I I -11 ) , T ABLE2 1  1-11), 
1  POTENT! I  I .SLPASP! I  I ,I»12.24) 
950  FORMAT(*0LATI TUDE  **13,*,  ASPECT  -  *A3.».  SLOPE  *»I3/ 

1  *0P0TFNTI AL  RADIATION  INCIOENT  TO  HORIZONTAL  SURFACE  AND  AOJUSTME 
INT  FACTORS  FOR  ASPECT  AND  SLOPE*/22X*LY         AOJUST* , 131 / 1XA6. 1XA6. 

3  2F10.2) I 
RETURN 
ENO 


CALL  NATURL 

C  DEFINE   AN  ALTERED  RESPONSE  UNIT 

10  CALL  OEFRU 

C  PRINT   THE    TITLE    PAGE    IF    THE    OUTPUT    IS    TO   BE  PRINTED 

IF(PLNOPT(3).NE.O)   CALL  TITLFM 
LINES  =  0 

C  SIMULATE   ONE  YEAR 

20  CALL  S1M1YR 

C  GET    THE   CHANGE    IN  THE   RECHARGE   REQUIREMENT   AND    IN   THE   PACK  WATER 

C   EQUIVALENT   AND   WRITE    THE    INFORMATION  ON    THE    PLANNING  UNIT  FILE 

RCHRG   =  0.0 

DO   3C   I   =  l.NUNIT 
30   RCHRG   =   RCHRG   »    ( R ECHRG  < I  )    •  RUWT I  I ) ) 

CHANGR   =   RCHRG  -  RCHRGO 

RCHRGO   =  RCHRG 

CHANGW   =   WE (371  I    -  WEO 

WEO    =  WEI371I 

C-  GET    THE    BIMONTHLY   FLOWS   AND    THE    PEAK  INFORMATION 

CALL  GBIMON 
CALL  GPEAK  (I0ATE1) 
DATE  1   »  PEKDAT 
DATE  2  =  I0ATE1 

WR  I  T£    112.9101    NPLAN, BLOCK! 1 t . YRTOT . CHANGR , CHANGW. B I MNTH. PEAK WE, 
1  0ATE1,PEAKR0,DATE2 
910  FORMAT! I2.16F6.2) 

C  IF  SPECIFIED,   OUTPUT  THE  COMPILED  RESULTS 

IFIPLNOPT(3).EQ.0l   GO  TO  40 
CALL  OUTPT 

C  DETERMINE   THE   EFFECTS  OF   THE   TIME  TRENDS 

40  CALL  TRENDS 

C  IF  THIS   IS  THE   YEAR   JUST  BEFORE   THE  NEXT   MANAGEMENT  PLAN,  STORE 

C   THE   PRESENT  MODEL  CONDITIONS  ON  THE   SCRATCH  FILE  TO  PROVIDE  THE 

C   STARTING  POINT  FOR  THE   NEXT  PLAN 

I F ( YEAR  ♦   1  -  NEXTYR)  60,50 
50  REWIND  16 

CALL   PUTREC   ( 16 .FORNXT , L4NXT ) 

C  READ  THE  NEXT  YEAR 

60  CALL  GETREC    ( 11 , BLOCK , 1 869, I  END) 
IFIIEND.EO.OI  GO  TO  20 

C  ENO  OF   FILE  -   IF  THERE   IS  ANOTHER  MANAGEMENT  PLAN,   READ  THE 

C   INITIAL  CONDITIONS  BACK  FROM  THE   SCRATCH  FILE,   BYPASS  THE  OATA 

C   TAPE   UP   TO  THE   FIRST  YEAR,   AND  GO  ON  TO  THE  NEXT  MANAGEMENT  PLAN 

IF [NEXTYR  -  9999)  70,80 
70  CALL  BYPASS 
REWIND  16 

CALL  GETREC    ( 1 6 , FORNXT , L4NXT , I ENO ) 
GO  TO  10 

C  IF  SPECIFIED,  COPY  THE  TIME  TRENDS  FILE 

80   IFIPLN0PTI4) .E0.01   GO  TO  110 
REWIND  17 
GO  TO  100 
90  WRITE  (6,990)  LCOPY 
990  FORMAT! 13A10.A6I 
100  READ   (17,9901  LCOPY 
IF  I  EOF  1 171 )  110.90 

C  RETURN   TO  THE    PRIMARY  OVERLAY 

110  CONTINUE 

CALL  CORE  (0) 
END 


Program  MANAGE 

OVERLAY  IOLAYS.2.2) 
PROGRAM  MANAGE 

C  PERFORM  THE  MANAGEMENT   STRATEGY  SIMULATION  AND  CREATE  THE  PLANNING 

C  UNIT  FILE 

COMMON  DATIME 12) .OECMAL , NRMANG . NS AVED , NYE ARS , PLNOPT ( 19 ) , PLUN IT ( 6  I , 
1  RECOVR, REGI0NI8) ,REG0PT(5) , S AVE , SEDRN2 . WE  I GHT 
INTEGER  DAT  I  HE, PLNOPT, PLUN IT, RECOVR, REG  I  ON, REGOPT, SAVE, SEDRN2 
C0MM0N/M/ALTYRI8) .BOUND (6, 8) , CALDEF 1 8 ) , COVDEN ( 8  I ,CUT(8)i 

1  DEC  IDS! 2,8) ,ORE ADY ( 8 ) .ENGBAL 18) .EXPKIBI , EXPK1 1  8 ) , FREWAT I  8 ) .LAST  1 , 

2  L ASUSD I  8  I , LCOPY 1 14) ,NDYSN0I8) .NEXT YR . NPL AN. NUM. NUN  I T . ONTRES I  8 ) . 

3  PARAHI9I .PHASE! 8  1 .PHI  SO! 8) , PREWEO! 8) .RDISTI8) , RDMAX I  8) , RECHRGI 8 ) . 

4  REGR0W(2,8) .RUNUM! 8) , RUWT ( 8  I , SEOI NC , SEEOAT ( 2 1 ,SEEDYRI2I. 

5  SIM TM 1(3. 8) .TCOEFF I  81 .TYPCUTI8) 

INTEGER  ALTYR, BOUND, ORE ADY, PHASE, RUNUM, S EEDAT , S EEDYR , TYPCUT 
COMM0N/TIME/CANREF.C0MAX2.C0NAV 

COMMON/UTILTY/BL0CKI1889I , CHANGR ,CH ANGW , OATE ( 2 ) , DAT E S I  4  I , L I NES , 
1  NAME, NOAY.RCHRGO.RO 1 372) .WE  13721  ,WEO , YE AR , YRTOT I  3  I 
INTEGER  OATE, DATES, YEAR 

DIMENSION  BIMNTHI6)  ,ETO(  3721  ,  PPT  (372)  ,R  AO  (3721  ,THAX(  3721  ,  TM  INI  3721 
EQUIVALENCE    I  BLOCK  I  2  I , THA X  I  1  I  I , ( BLOCK ( 374 ) , TMI N I  1 1  1 , I  BLOCK  I  746 ) , 

1  PPTIl  )  I  ,  I  BLOCK  I  1U8I  .RADII  )  I  ,  I  BLOCK  1 1 490  ),  ETO  I  1  )  I ,  (  BLOCK  I  1 864  I  , 

2  COM  AX  I , (BLOCK (1865) .VEGTYP) , ( BLOCK (  1 866  I , TRSHL D ) , I  BLOCK  I  1867), 

3  TMPMLT ) , I  BLOCK!  1868) .WILTPT) , IBL0CKI1B71) .DCDMAXI , I  BLOCK  I  1872), 

4  ISO TRM) , (BLOCK!  1873)  .PEKO ATI  ,( BLOCK ( 1 880 1  , BI MNTH! 1 ) I, 

5  I  BLOCK  11 886 1  .PEAKWEI , I  BLOC K ( 1 888 ) , PE AKRO ) 
INTEGER   PEKDAT . VEGTYP 

C  NOTE  -  THE   DIMENSION  OF   -FORNXT-  MUST  BE   EQUAL   TO  THE  LENGTH  OF 

C   COMMON   BLOCK   /M /  AND  THAT   LENGTH  MUST  BE  STORED  IN  -L4NXT- 

DIMFNSION  FORNXTI313I 

EQUIVALENCE    (ALTYR! 1  I .FORNXT! 1) I 

CALL   CORE  (-1) 

L4NXT  =  313 

REWIND  17 

REWINO  IB 

WRITF   (18,9001  PLUNIT.DATIME 
900   FORMeTI*l*6Al'-,52X2A10/*0MANAGEMENT    STRATEGY  DESCRIPTION*) 
LASTI   =  -1 
SEEDYR 111    =  9999 

C  MAKE    A   PASS   THROUGH    THE   DATA   TO  TRANSFER    THE   YEARLY   RESULTS   OF  THE 

C   NORMAL   SIMULATION  TO  THE   PLANNING  UNIT  FILE 

CALL  NORM 

C  READ    THE   FIRST   MANAGEMENT   PLAN  CARO   -    IF    THERE    IS   NONE,    THIS  UNIT 

C  IS    'IDT   MANAGED,    BUT   WAS    INCLUDED  ONLY    AS   PART   OF   A  REGION 

nplan  =  0 
CALL  RDPLAN 

IFIN=XTYR.EQ.9999I    GO  TO  110 

C  BYPASS    THE    DATA    ON   THE    BASIC    FILE   UNTIL    THE    FIRST   YEAR    OF  THE 

C   MANAGEMENT   PLAN    IS  FOUND 

CALL  BYPASS 
C  OEFI'.E    THE    NATURAL   RESPONSE  UNIT 


Subroutine  BYPASS 


SUBROUTINE  BYPASS 

C  BYPASS  THE  DATA  ON  THE  BASIC  FILE  UNTIL  THE  FIRST  YEAR  OF  THE 

C   MANAGEMENT  PLAN  IS  FOUND 

COMM0N/M/ALTYR(8l .BOUND (6,8  I , CALDEF ( 8 ) , COVDEN ( 8  I , CUT ( 8 )  , 

1  DEC  IDS (2, 8  I , DREAOY ( 8 ) , ENGBAL ( 8 ) ,EXPK 1 8 ) .EXPK1 1  8 ) , FREW AT  I  8 ) . LASTI, 

2  L ASUSD! 81, LCOPY! 14) ,N0YSN0I8) , NEXTYR, NPLAN, NUM, NUNIT , ONTRES ( B ) , 

3  PAR  AM (9) .PHASE (8) ,PHISQ(8) , PREWEO! 8  I , RO 1ST ( 8 1 , RDMAX I  8 1 , RECHRGI 8  I , 

4  REGR0WI2 .81 , RUNUM I  8  I , RUWT I  8 ) , SEOINC , SEE  OAT ( 2  I , S EEDYR ( 2  I , 

5  SIMTM1I 3,81 .TCOEFF (81 , TYPCUT! 8 1 

INTEGER  AL TYR, BOUND, DRE ADY, PHASE .RUNUM, S EEDAT. SEEDYR, TYPCUT 
COMMON/UTI LTY/BLOCK 1 1889) , CHANGR , CH ANGW , OAT E ( 2  I , DAT ES ( 4  I , L 1NES , 
1  NAME, NOAY.RCHRGO.RO 1 372 1  .WE ( 372  I , WEO, YE AR , YRTOT ( 3 ) 
INTEGER  OATE, DATES, YEAR 

DIMENSION  BIMNTHI6) , ETO 1372) , PPT  1 372) , RAD (3 72  I .TMAX I  372) .TMINI 372) 
EQUIVALENCE    IBL0CKI2) , TMAX II  I ) , I  BLOCK  I  374  I , T M IN! 111,! BLOCK! 746), 

1  PPTIl) ) , (BLOCK  1 1118  I ,RAOI 1) ) , (BLOCK! 14901 , ETO ( 1 ) ) , ( BLOCK  I  18641, 

2  COM  AX  I , [BLOCK  I  1865) .VEGTYP I , (BLOCK (1866) .TRSHLO) . (BLOCK (  1867)  . 

3  TMPMLT) , I  BLOCK  I  1868) , WI LTPT ) , I  BLOCK  1 1 87 1 ) , DCDM AX  I , I  BLOCK  I  1872), 

4  I  SO  TP M) , (BLOCK  11873) .PEKDAT) , I  BLOCK (  1880 ) , B I MNTHI 1) ), 

5  (BLOCK (1886) .PEAKWEI , I  BLOCK  I  1888  I , PEAKR  0 ) 
INTEGFR   PEKDAT, VEGTYP 

REWIND  11 

C  GET   A  YEAR 

10  CALL   GETREC    1 1 1 , BLOCK , 1 889 , I  END ) 

IF ( I  END )  20,30 
20  WRITE    16,9101  NEXTYR 
910  FORMAT(«CTHE   EXTENDED   DATA  FILE   ENDED  BEFORE  MANAGEMENT   PLAN  YEAR* 
1   14,*  WAS  FOUND  -  JOB  ABORTED*) 
CALL  ABORT 
30  IFINEXTYR  -   INTIBLOCKI 1 ) I )  40,50,10 
40   J YE A R    =■    INTIBLOCK(l) ) 

WRITE    (6,9201    NEXTYR, JYEAR 
920  FORVAT(*0THE    EXTENDED   OATA   FILE    DOES   NOT   CONTAIN   MANAGEMENT    PLAN  Y 
1EAR«I4,«.      THF    NEXT    YEAR    ON   THE    FILE    IS*I4,»   -   JOB   ABORT  ED* ) 
CALL  ABORT 
5C  YEAR   =  BLOCK  111 
RETURN 
END 


Subroutine  DEFRU 


SUBROUTINE  DEFRU 

C  OEFINE   A  RESPONSE  UNIT   [OR  REDEFINE  ONE   PREVIOUSLY  DEFINED) 

COMMON   DAT  I  ME (2  I  .OECMAL ,N» MANG , NS AVEO , NYE ARS , PL NOPT ( 1 9  I , PLUN I T ( 6 ) , 
1  RECOVR, REGION  IB) .REG0PTI5) , S AVE . SE0RN2, WE IGHT 
INTEGER  0 A  TI ME , PLNOPT , PLUM  T , RECOVR ■ REG  I  ON, REGOPT, SAVE, SEORN 2 
COMMONV!'./  ALTYR  IB)  .BOUND  1 6, 81  .CAL0EFI8)  .COVDEN!  fl  I  ,CUT  I  8  1  , 
1    DEC  IDS  I  2, HI . ORE  ADY ( 8 1  .ENGBAL! 8) ,EXPK 181, EXPK1(8I,FREWAT!B), LASTI, 
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2  LASUSOI 8) .LCOPYI 14) ,H0YSN0(8I , NEXT YR . NP L AN , NUM, NUN  I T , ONTR E S I  8  I , 

3  PAR  AM  I 91 .PHASE! 81 , PH I SQ ( 8 ) , PRE WEQ ( 8 ) . RD I S T I  8  I ■ ROM AX ( 8  I , RECHRG< 8  I , 

4  "EG»OW(2.8)  ,SUNUMi8l  ,RUWT  (81  .  S  EOI  NC  ,  S  EEOAT  I  2  I  .SEEDYR I  2), 

5  SIMTM1 (3,81 .TCOEFF (8) .TYPCUT 18  I 

INTEGFP  AL TYR, BOUND, ORE AO Y, PHASE. RUNUM, SEE  DAT, SEEOYR , TYPCUT 
COMMON/ S/AVSO I L( 11) .OECLINIll) .NROADS , RATNRM ( 1 1 1 .ROADMII 11), 
1  ROADWIlt) .TANCUTIll I ,TANFIL(11) ,T ANRHOI 11  I , YRCNST ( 1 1 1 
INTEGER  YRCNST 

COMMON/UT1LTY/BLOCKI 188  9) , CHANGR , CHANGW , DATE ( 2 ) , DATE S I  4 ) , L I NES , 
1  NAME,N0AY,RCHRG0,RO(372 I , WE (372 ) , WEO, YE AR.YRTOT  (  3 ) 
INTEGER   OATE, DATES, YEAR 

DIMENSION  B I  MNTH (6) ,ET0(372I , PPT ( 372) ,RAO(  372) , TMAX  (  372 ) ,  TM INI  3721 
EOU I  VALENCE    I  BLOCK  I  2  I , TMAX I  1 1  I , I  BLOCK  I  374  I , TMI N I  1 ) I , I  BLOCK  I  746 )  , 

1  PPT| 1 ) ) , (BLOCK! Ill B) ,RAO(l) ) , ( BLOCK ( 1490) ,ETOI 1) ) , I  BLOCK  I  1864), 

2  CDMA  X ) , (BLOCK (1865  I .VEGTYPI , I  BLOCK ( 1866 ) , TRSHL D ) , I  BLOCK  I  1867), 

3  TMPMLT) , (BLOCK! 1 86 8 ) , W I LT PT I , ( BLOCK  I  1 87 1 1 , DCDM AX ) , ( BLOCK  I  1872 ) , 

4  ISOTRM), (BLOCK!  1 87 3 ) , PEKDAT ) , I  BLOCK  I  1 880 1 , B I MNTH! 1)1, 

5  I  BLOCK  I  1886) »PEAKWE ) , I  BLOC K 1 1 888 ) , PE AKR 0) 
INTEGER  PEKDAT, VEGTYP 

INTEGER  YRALT 
YRALT  =  NEXTYR 

C  WATCH  FOR  ROAO  CONSTRUCTION   (SEDIMENT  MODELING) 

IFIIROADSINI.EQ.ll   GO  TO  140 
NPLAN   =   NPLAN   ♦  I 

C  IF  THE  RESPONSE   UNIT  NUMBER   IS  ZERO,   THIS   IS  HEATHER  MODIFICATION 

1    IFINUMI  2C.10 
10   SEEDYR(l)    =  NEXTYR 
SEEDYR ( 2 )    =   P ARAM ( 1 ) 

SEED  AT  I  1 1   =  JWYDAT   I  I  NT ( P ARAM ( 2 ) / 100 . ) , I  NT  I AHOD I  PAR AM  I  2 )  ,  100 .  I  ) ) 
SEEDATI2)    -   JWYOAT    ( I  NT  I P ARAM! 3 ) /100 . I , I  NT  I AMOD I PARAMI 3  I . 100 . I > ) 
SEDINC    =    1.0   ♦   P ARAM  1 4 ) 
GO  TO  140 

C  IF  THIS  RESPONSE   UNIT  NUMBER   IS  ALREADY   IN  THE  TABLE,   THIS  CARO  IS 

C  REOEFINING  THE  UNIT 

20  DO  30  I   =  l.NUNIT 
N  =  I 

IF(RUNUMIN)   -  NUM)  30,80 
30  CONTINUE 

H  =  NUN  IT  ♦  1 
IF(8  -  N)  40,50,50 
40  URITE   (6,910)  NUM 
910  FORMAT ( *0A  MAXIMUM  OF  7  ALTERED  RESPONSE  UNITS   IS  ALLOWED  OUE  TO  I 
INTERNAL   PROGRAMMING  REQUIREMENTS  AND  *I6,*  WILL   BE  NUMBER  8  -  JOB 
2AB0R  TED* ) 
CALL  ABORT 

c  START  THIS  RESPONSE  UNIT  OUT  UNDER  THE  PRESENT  CONDITIONS  OF  THE 

C   NATURAL  RESPONSE  UNIT 

SO  NUN  I  T  =  N 

RUNUM I NUNI T )   =  NUM 

TCOEFFINUNIT)   -  TC0EFFI1) 

COVDENINUNIT)  =  COVDENU) 

DECIDSIl.NUNIT)   -  DECIOSIl.l) 

DEC  I DSI 2  *NUNI T )  -  DECIDSI2.1) 

CALDEF INUN I T )   =   CALDEF I  1 ) 

ORE  AOY 1  NUN  I  T I   =■  DREADYI1) 

ENGBAL INUNIT)   ■  ENGBALI1) 

FREWATINUNIT)   •  FREWAT ( 1 ) 

LASUSDINUNIT)    ■  LASUSDI1) 

NDYSNOI NUNI T)   =  NDYSNOIl) 

ONTRESINUNIT)  =  0NTRESI1) 

PHASEINUNIT)  -  PHASEI1) 

PREWE0INUN1T)   ■  PREWEO(l) 

RECHRG  (  NUNI  T )   =■  RECHRG  1 1  ) 

SIHTH1 I l.NUNIT)   =  SIMTMlll.l) 

SIMTM1 1  2, NUNI T)   =  SIMTM1 (2,1) 

SIMTM1 1  3, NUNI T)   =  SIMTM1I3.1) 

C  DEFINE  THE  UNIT  WEIGHT  AND  REDEFINE  THE  NATURAL  RESPONSE  UNIT 

C   WEIGHT 

RUWT(NUNIT)   =  PARAMI1I 

RUWTI1)   =  1.0 

00  6  0   I   »  2, NUN  IT 
60  RUWT(l)   =  RUWTI1)  -  RUWTII) 

IF(RUWTIl))  70,75,75 
70  WRITE  (6.92U) 

920  FORMAT ( *0THE   ALTERED  RESPONSE  UNITS   ACCOUNT  FOR  MORE  THAN   100  PERC 
1ENT  OF  THE  PLANNING  UNIT  -  JOB  ABORTED*) 
CALL  ABORT 

c  IF  THE  NATURAL  RESPONSE  UNIT  IS  LESS  THAN  1/2  OF  ONE  PERCENT,  SET 

C  IT   TO  ZERO 

75  IFIRUWTdl.LT. 0.005)  RUWTII)  =  0.0 

C  DEFINE   I0R  REDEFINE)  THE  PARAMETERS  FOR  THE  RESPONSE  UNIT 

80  ALTYRINI   =  NEXTYR 

C  IF  THE  COVER  DENSITY  WAS  SPECIFIED  (PARAMI2)  WAS  FLAGGED  WITH  A 

C   MINUS  SIGN).  GO  DEFINE  THE  CORRESPONDING  CUT 

IFIPARAMI2I.LT. 0.01  GO  TO  160 

CUTINI   -  PARAM ( 2 ) 
C  REDEFINE   THE  COVER  DENSITY  AND  TRANSM I SS I V I TY  COEFFICIENT 

COVDENINI   =  COVDENINI  »  (1.0  -  CUTINI) 
90  TCOEFFIN)   =  TC  (COVDENINI) 

IFICOVDENIN) .EO.0.0)  ONTRESIN)  =  0.0 

I F ( VEGTYP . NE . 3. AND. VEGTYP.NE .4 )   GO  TO  100 

DECI0SI2.N)  =  0ECIDSI2.N)  *   11.0  -  CUTINM 

DECIOSIl.NI  =  TC  (DECIDSI2.N)) 

C  DEFINE   THE   BOUNDARIES  FOR  THE  TIME  TRENOS  FUNCTIONS 

100  CALL   GBOUND  IN) 
C  BALANCE   THE  REDISTRIBUTION  FACTORS 

CALL  BALANC 

C  READ   THE  NEXT  MANAGEMENT   PLAN  CARD  ANO  IF   IT    IS  FOR  THE   SAME   YEAR , 

C  GO  BACK  TO  DEFINE  ANOTHER  RESPONSE  UNIT 

140  CALL  ROPLAN 

IFIYRALT  -   NEXTYR)  150,145 

145    IFIIROAOSINI    -    1)  1,140 
C  DETERMINE   THE   INITIAL   EFFECTS   (IF  ANY)   OF  THE  TIME  TRENDS 

150  WRIT"    (17,9401    PLUNI T.DATIME 

940  FORMAT(*1*6A10.52X2A10/115X*ALTERED  CONOITIONS*/*OCHANGES   IN  PARAM 
1ETERS  DUE   TO  THE   EFFECTS  OF   THE  TIME  TRENDS*/) 
CALL  TR3NDS 

C  ADO   THIS   INFORMATION  TO  THE   STRATEGY  LIST 

CALL   SLIST  (YRALT) 
RETUFN 

C  USE   THE   SPECIFIEO  COVER  DENSITY   ANO  DEFINE   THE  CUT   (REMEMBER . 

C  PAR  AM ( 2 )    IS  NEGATIVE) 

160  CUTINI   =   l.C   *   IPARAM(2)/C0VDEN(N) I 

IFICUTINI)    18?, 170.170 
170  COVDENINI    =   -   PAR AM  1 2 ) 
GO   TO   9  3 


180   PARAKI2I    =   -   PARAM ( 2 ) 

WRITE   (6,950)   COVDE N I N ) , PARAM I  2  I 
950   FORMAT! * CTHE   CURRENT   COVER   DENSITY    IS    0NLY«F5.2,«,    BUT   THE  MANAGEM 
1ENT   PLAN   IS  REQUESTING   A  CUT*/*     WHICH  WILL   YIELD  A  SPECIFIED  COVE 
2R  DENSITY  0F4F5.2,*  -  JOB  ABORTED*) 
CALL  ABORT 
END 


Function  IROADS 


FUNCTION   IROADS  (DUMMY) 

C  CHECK  FOR  ROAD  CONSTRUCTION   (SEDIMENT  MODELING).     SINCE  THE 

C   SEDIMENT  MODEL   IS  TOTALLY   INDEPENDENT.   MERELY  STORE  THE 

C   PARAMETERS   NOW   FOR   MODELING   AFTER   THE   MANAGEMENT   PHASE  IS 

C   COMPLETE 

COMMON/M/ALTYR 18) .BOUND (6 ,8) .CALDEF 18  I • COVDENI 8 ) , CUT ( 8 ) , 

1  nECIOS(2,8) . ORE  ADY ( 8 ) , ENGB AL ( 8 ) , EXPK ( 8  I , EXPK1I 8  I , FREWAT ( 8 ) , LAST1 , 

2  L ASUSD ( 8 ) .LCOPYI 141 .NDYSNOI 8) .NEXTYR. NPLAN, NUM, NUNI T, 0NTRESI8) , 

3  PAR  AMI  9) .PHASE (8) .PHI  SOI  8) ,PREWEQ(8I ,R0IST(8) , RDMAX ( 8  I , RECHRG I  8  I , 

4  REGROWI2.8I , R  UNUM I  8 ) ,R  UWT I  8 ) , SE 0 1 NC . SEE  OAT  I  2  I . S EEDYR ( 2 ) , 

5  SIMTM1I3.8) ,TCOEFF 181 , TYPCUT (8) 

INTEGER   AL  TYR , BOUND ,DREADY, PHASE , RUNUM, S EE DAT , SEEDYR , TYPCUT 
C0MHON/S/AVS0ILI11) .DECLINIll) , NROAOS , RATNRM 1 1 1 ) , ROAOMI I  11), 
1  ROADWI 11) .TANCUTIll I .TANFILIll I , TANRHOI 11  I .YRCNST I  11) 
INTEGER  YRCNST 

C0MM0N/UTILTY/BL0CKI1889) , CHANGR , CHANGW , DAT E ( 2  I , OATES 1 4 1 , L INES , 
I  NAME, NDAY.RCHRGO.RO I  372) . WE  I  372 ) , WEO , YE AR , YRTOT I  3 ) 
INTEGER  DATE, OATES, YEAR 

DIMENSION  BIMNTHI6) .ETCH 372 1 , PPT  I  372 ) ,RAO( 372) , TMAX I  372 ) , TMINI 372) 
EOUI VALENCE    <BL0CK(2> , TMAX I  1) ) , (BLOCK (374) ,TMIN(1) ) , ( BLOCK ( 746  I , 

1  PPT(1I),(BL0CKI1118),RAD(1)I . I  BLOCK! 1490). ETO( 1  I ) , I  BLOCK! 1B64I, 

2  COM AX  I , I  BLOCK  1  1865 ) • VEGTYP ). I  BLOCK ( 1866 ) . TRSHL D ) . I  BLOCK  I  1867) . 

3  TMPMLT) , (BLOCK (1868  I .WILTPTI , I  BLOCK  1 1871) .DCDMAX) , (BLOCK! 1872), 

4  ISOTRM) , (BLOCK  I  18731  .PEKDAT ) , ( BLOCK!  1880 ) ,81 MNTH I  1 ) ), 

5  I  BLOCK  I  1886) .PEAKWE) , I  BLOCK  1 1888) , PEAKRO) 
INTEGER  PEKDAT, VEGTYP 

10  IFINAME.E0.10HROAD  CONST)   GO  TO  20 
IROADS   =  0 
RETURN 

20  I F ( NROADS  -  11)  40,40,30 
30  WRITE   (6,910)  NEXTYR 
910  FORMAT (*OTHERE  ARE   MORE   THAN  11   ROAD  CONSTRUCTION  CARDS  INCLUDED, 
ISO   YEAR«I4,»   WAS  IGNORED*) 

GO  TO  50 

C  STORE  THE  PARAMETERS 

40  NROADS   =  NROADS  ♦  1 

YPCNST(NROADS)   =  NEXTYR 

ROADMI INROADS)    -   PARAM ( 1 ) 

ROADWINROADS)   *  PARAMI2) 

RATNRMINROADS)   =  PARAMO) 

AVSOIKNROADS)   =  PAR  AM(4 ) 

DECLINI NROADS)   =  PARAM I  5 ) 

TANCUT I NROADS)   *  PARAM I  6 ) 

TANFIL INROADS)   =  PARAM ( 7 ) 

TANRHOI NROADS)   =  PARAM ( 8 ) 
SO  IROADS  =  1 

RETURN 

END 


Subroutine  NATURL 


SUBROUTINE  NATURL 

C  DEFINE  THE  NATURAL  RESPONSE  UNIT 

COMMON /M /AL TYR 1 8 ) ,B0UND(6,8) .CALDEF 1 8 ) , COVDENI 8  I . CUT  1 8 ) , 

1  DEC  IDS  I  2.6) .DREADYI8) , ENG8AL 1 8  I , EXPK I B ) ,EXPK1 1  8 ) , FREWAT! 8 ) .LAST  I. 

2  LASUSOI 8 ) .LCOPYI 14) . NOYSNOI B) . NEXTYR .NPLAN. NUM. NUN  I T .ONTRES ( 8  > , 

3  PARAM (9) .PHASE (81 ,PHISQ(8) ,PREWE0I8) ,RDIST(8) ,RDMAX( 8) , RECHRG( 8 ) , 

4  REGROWI2.8I .RUNUMI8) ,RUWT 1 8 ) , SEOI NC, S EE  DAT  I  2 ) , S EEDYR I  2 ) . 

5  SIMTM1 13,81 .TCOEFF IB) .TYPCUT 18  I 

INTEGER  AL T YR, BOUND, DRE AOY, PHASE, RUNUM, SEE DAT, SEEDYR, TYPCUT 
C0MM0N/UTILTY/BL0CKI1889) .CHANGR .CHANGW , DATE  1 2 ) , DATES  I  4 ) , L I  NES  , 
1  NAME , NDAY.RCHRGO.RO I  372) , WE  1 372 ) , WEO , YE AR , YRTOT ( 3 ) 
INTEGER   OATE .DATES, YEAR 

DIMENSION  BI MNTH I  61 .E TO  I  372) . PPT  I  372 ) , RAD( 372 ) , TMAX ( 372 ) , TM I N (  372  I 
EOUI VALENCE    I  BLOCK  I  2 ), TMAX 1 1 ) ) , ( BLOCK  I  374 ) , TH INI  1 ) ) , I  BLOCK  I  746) . 

1  PPT (1 ) I , I  BLOCK  I  1118) ,RA0(1) ) , I  BLOCK  1 1490 1 , ETO I  1) ), I  BLOCK  I  1864  I . 

2  COM AX  I , (BLOCK!  1865) .VEGTYP) , I  BLOCK ( 1866  I . TRSHLD I . IBLOCKI  18671, 

3  TMPMLT) , IBLOCKI 1868) , W I LTPT I , I  BLOCK ( 187 1 1 , DCDM AX ) , ( BLOCK (  1872), 

4  ISOTRM | , IBLOCKI  1873) .PEKDAT ) , ( BLOCK  1 1880 ) , 8 1 MNTH! 1 ) I , 

5  (BLOCK!  1886), PEAKWE), ( BLOCK  1 1 888  I , PE AKR 0 1 
INTEGER  PEKDAT , VEGTYP 

C  THE   NATURAL  RESPONSE  UNIT  STARTS   AS   100   PERCENT  OF  THE  PLANNING 

C   UNIT  AND   IS  REDUCED  AS  MANAGEMENT  PLANS   ARE  INTRODUCED 

RUWTII)    »  1.0 

RDIST! 1 )    =  1.0 

RUNUMI1)    =  0 

C  DEFINE   THE   COVER  DENSITY,   TRANSMI SS I V I TY  COEFFICIENT,   ETC..  FROM 

c  THE   BASIC  FILE 

TCOEFF(l)   =  BL0CKI1862) 

COVDENI 1 )   =  BLOCKI 1863) 

DECIOSIl.l)    =  BL0CKI1869) 

DECIDSI2.1)   =  BL0CK11870) 

PR  E  WEO ( I )   =  BLOCK  118741 

RECHRGI 1 )   =  8L0CKI1675) 

RCHRGO  =  RECHRGI 1  I 

WEO  =  PREWEOIll 

C  SEE    SUBROUTINE   TRENDS  FOR   DEVELOPMENT   OF  THE  EOUATION  BELOW 

REGROW   12,1)    =   1.3  -   10.5  «  EXP   1-1.609437912  «  COVDENI 1 J/CDMAX) ) 

REGR  OW   (t.l)    =  0.5 

CALPEF(l)   =  0.0 

DB  EAOY 1 1 )   =  0 

ENGBAL ( 1 1   =  0.0 

FREWATI  1  I    -  0.0 

LASUSDIll   =  0 

NOYSNO(l)   =  0 

ONTR'Slll   =  0.0 

PHAS5I1)   =  0 

SIMTMlll.l)  =  0.0 

S1MTM1 (2,1  )  =0.0 
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SIHTM1|3,1I   =  -1.5 

TYPCUT!  II    =  0 

NUM  T    ■  1 

OETU=N 

ENO 


Subroutine  NORM 


SU9HCUTINC  NORM 

C  TRANSFER   THE    YE  ARLY   RESULTS   OF   THE   NORMAL   SIMULATION   TO  THE 

C  PLANNING   UNIT  FILE 

COMMON   DATII'E  (21  .OEC  MAL  .  NR  HANG  ■  NS  AVEO .  NT  E  ARS  .  PLNOPT  (  1 9  I , PLUN I T ( 6 ) , 
1   RECOVR.RECIONIRI .REGOPTI5) . S AVE , SEDRN2 , WE  I GHT 
INTEGER   CUT  I  ME , PLNOPT . PLUN I T , R ECOVR , REGl ON , REGOPT , SAVE . SEDRN2 
COMMON/UTILTY/BLOCK (  18891  , CHANGR .CHANGW . 0 AT E ( 2  I  i DATES ( 4 ) ,L I NES, 
1  NAME,NDAY,9CHRGC .R01372I ,WE (372) , WEO , YE AR , YRTOT [3  I 
INTEGER    OATE iDATES.YEAR 

01  MENS  ION  BIMNTHI6I ,ET0(372),PPT(372I.RA0( 3721 tTNAXI 3721 iTHINI 3721 
EOUIvALtNCE    (BLOCK  (21  ,TMAX<  II  I  ,  I  BLOCK  (  374 1  .THINI II ) , I  BLOCK  I  7*6  I. 

1  PPTI 1  I  I , (BLOCK! 11181 .RA0I1I I , I  BLOCK  I  1490 1 .ETOI 1  I  I . I  SLOCK  I  18641, 

2  COMSXI  , (BLOCK (1865  I .VEGTYP) , I  BLOCK (1866  I. TRSHLOI, (BLOCK (  18671, 

3  THPMLT I , (BLOCK! 18681 .WILTPT) . I  BLOCK ( 1 87 1  I , OCOMAX I , (BLOCK I  18721, 

4  ISOTRMI , I  BLOCK  I  1873) , PEKOAT ) , I  BLOCK  I  1 880 1  .BIMNTHI II). 

5  (BLOCK!  18861  , PE AKUE I , I  BLOCK  1 1888) , PEAKROI 
INTEGER    PEKOAT, VEGTYP 

REWIND  11 
REWIND  12 

00  30  I   =  l.NYEARS 
CALL  GETREC    111, BLOCK, 1889, IE NO) 
IFIIENOI  10,20 
10  J  »   I  -  1 

WRITE    (6,9101  NYEARS.J 
910  FORMAT ( «OTHE  REGION  CARD  SPEC  I F I ES* 1 4, *  YEARS,   BUT   THERE   ARE  ONLY* 
1   14, *  ON  -DATFIL-.     JOB  ABORTED* ) 
CALL  ABORT 

C  BL0CK11116)   =  ACCUMULATED  PREC I P  ON  9/30 

2C  WRITE    (  12,9201   BLOCK ( 1 ), BLOCK (1876  I. BLOCK! 1 1 16 ),( BLOCK! K I .K-1877, 
I  1889) 
920  FORMAT ( *  0*16F6.2I 
30  CONTINUE 
RETURN 
END 


Subroutine  RDPLAN 

SUBROUTINE  RDPLAN 

C  READ   A   MANAGEMENT   PLAN  CARD 

COMMON/H/ALTYRIS) .BOUND (6, 8 1 .CALDEFI8) , COVOEN I  8  I , CUT  I  8 ) , 

1  DEC  IDS  1 2, 8 1 .0READYI8) .ENGBALI8I ,EXPK(8) .EXPKl 1 8  I , FREWATI 8 ) ,LAST1, 

2  LASUSD! 8 ) ,LCOPY! 141 .NDYSN018) , NEXTYR , NPLAN, NUM, NUN  1 T , ONTRE S I  8  I  , 

3  PAR AM! 91 .PHASE (81 , phi  SOI  9  I .PREWEQIB) , RO I  ST  1 8 1 , ROMAX ( 8  I , RECHRGI 8 > . 

4  REGROW(2,8l ,RUNUMI8) , RUWT 1 8  I , SEOINC, SEEDAT ( 2 1 , SEEDYR ( 2 ) i 

5  SIMTHl (3,81 ,TC0EFF(8) ,TYPCUT(8I 

INTEGER  ALTYR, BOUND, ORE AO Y, PHASE , RUNUM, SEE DAT, SEEDYR, TYPCUT 
C0MM0N/UTILTY/8L0CKI1889) ,CH ANGR ,CH ANGW, OATE ( 2  I , OAT ES 1 4 ) , L INES , 
1  NAHE»NOAY,RCHRG0»ROI372> , WE ( 372 ) ,MEO, YEAR, YRTOT 1 3 ) 
INTEGER  DATE, DATES, YEAR 

DIMENSION  BIMNTHI6) , ETOI 372 1  , PPT  1 372  I .RAO! 372) , TMAX I  372 ). THINI  372) 
EQUIVALENCE   ( BLOCK ( 2 ) , TMAX ( 1 ) ) , I  BLOCK (37 4) ,TMIN( 1 1 ) , I  BLOCK ( 746) , 

1  PPT  I  1 ) ) , I  BLOCK! 11181 ,RA0!1I ) , ( BLOCK ( 1490 1 , ETO ( 1 ) ) , I  BLOCK  I  1864), 

2  COM AX) , (BLOCK! 1865) , VEGTYP I , ( BLOCK ( 1 866 ), TRSHLD I , I 8L0CK ( 18671. 

3  TMPMLT) , (BLOCK! 1868) .WILTPTI , ( BLOCK ( 1 87 1 ) , DCOMAX ) , I  BLOCK!  18721, 

4  ISOTRMI , (BLOCK!  1873) .PEKDATI , 1  BLOCK ( 1880 ) , BIMNTHI II )■ 

5  I  BLOCK  I  1886) .PEAKWEI , I  BLOCK i 1888 ) .PEAKROI 
INTEGER  PEKOAT, VEGTYP 

C  READ  THE  CARO 

READ   1191   NAME » NUM» NEXTYR, PAR AM ,SP£CCD 

IFINAME.E0.10HEN0   OF    STR)  10,20 
10  NEXTYR   =  9999 

RETURN 
20   L AST  1    =  NEXTYR 

C  IF  A  SPECIFIED  COVER  DENSITY  IS  INCLUDED,  FLAG  IT  WITH  A  MINUS 

IF(SPECCD.NE.O.C)   PAR AH ( 2 )   =  -  SPECCD 

RETURN 

END 


Subroutine  SIM1YR 

SUBROUTINE  SIH1YR 

C  SIMULATE   ONE  YEAR 

COMM0N/M/ALTYRI8I ,B0UN0(6,8) , CALOEF I  8 ) , COVOEN! 8 ) , CUT  I  8 ) , 

1  DECIOS(2,8),0REA0Y18l , ENGB AL 1 8  I , EXPK I  8  I , E XPKH 8  I , FREWAT ( 8  I , L AST  1 , 

2  LASUSDI 81 ,LCOPY( 14  1 ,NDYSN0(3) , NEXTYR , NPLAN, NUM. NUN  I T , ONTRES ( 8  I , 

3  PAR AM ( 9 ) .PHASE  18) , PHI  SOI  8) , PREwEQ ( 8 ) , RD I  ST ( 8 ) , RDM AX ( 8 ) , RECHRG ( 8 ) . 

4  RE  GROW  I  2, 8 1 , RUNUM ( 8 ) , RUWT ( 8 ) , S EDI NC , SEE  OAT ( 2) ,SEE0YR(2I . 

5  SIM  TV  113,8), TC0EFFI8) .TYPCUT (81 

INTEGER  ALT YR, BOUND, DREADY, PHASE, RUNUM, SEED AT, SEEDYR, TYPCUT 
COMMON/TIME/CANREF ,CDMAX2 ,CONAV 

COHMON/UTILTY/BLOCK! 1889) , CHANGR .CHANGW , DATE  I  2  I , OATE S ( 4  I , L I NES , 
1  NAME.NOAY.RCHRGO.ROI 3721 , WE ( 372 ) , WEO , YE AR , YRTOT ( 3 ) 
INTEGER  DATE .DATES, YEAR 

DIMENSION  B I MNTH ( 6 ) ,ETO ( 37  2  I , PPT ( 37  2 ) , RAO(  37  2I,TMAX(  3721  ,TM|N(  3721 
EQUIVALENCE    (BLOCK! 2) , TMAX I  1 ) I, ( BLOCK  1374), TM1N! II  I , 1  BLOCK  I  746  I , 

1  PPT ( I  1  I , (BLOCK ( 1113), RAO  II)) , I  BLOCK  I  1490 ) , ETO ( 1 ) ) , ( BLOCK ( 186*1 > 

2  COM  AX ), IPLOCKI 1865) .VEGTYP) , I  BLOCK  1 1866  ), TRSHLD), I  BLOCK ( 18671. 

3  TMPMLT) , I  BLOCK (1 868  I .WILTPT) , ( SLOCK  I  1 87 1 1 , DCDM AX  I ,  (  BLOCK (  18  721, 

4  ISOTRMI , (BLOCK  I  18731 , PEKDAT I , ( SLOCK  I  1880 1 , B I MNTH! 1 ) ), 

5  I  BLOCK  I  1P86I , PC AKWE I , I  BLOCK  I  1888)  .PEAKRC) 
INTEGFR    PEKOAT, VEGTYP 

COMMON/ WT9RAL/ ALLOW, E IF  ROM, E V APTR , GENRO, PEAKED, PREC I P , RAO  IN , 
1   PADLWN.P ADSWN, TMPMAX, TMPHIN, WATRIN 
YRT0TI1I   =  G.C 
YRTCTI2)   =  O.C 
YRT0TI3)    =  O.C 
YEAR   =  BLOCK  I  1) 
DO  13   I   a  l.NUNIT 
10  OREiHYl I )   =  0 


C  PERFORM  THE  SIMULATION 

PPTNOW    =  0.0 

PEAK  FO    =  '•.L 

00    90  NDAY   *  1,372 

IF  I TMAXINDAVl   ♦  1.E5C)   3:. 90 

C  DEFINE    THC   DRIVING  VARIABLES 

30   TMPMAX    '  TMAXINOAYI 

TMPMIN    *  THININDAY) 

PPTN  RM    »    PPTINOAYI    -  PPTNOW 

PPTNOW    =  PPT(NDAY) 

R  AD  I N   =  RAD(NDAY) 

WE(NDAY)    «  O.C 

ROINOAY)    =  0.0 
C  00   NOT    ALLOW    INTERCEPTION    IN    JULY   ANO  AUGUST 

ALLOW  =  1.0 

ifinday.ge. 280. and. nday.le. 3*11  allow  =  0.0 

ifinoay.eo.pekdati  peakeo  »  1.0 
c  watch  for  deciduous  forests  and  their  change  of  seasons 

ifivegtyp.eq.3.0r. vegtyp. e0.4)  call  oecous 
c  hake  a  pass  through  the  water  balance  routines  for  each  response 

C  UNIT 

DO  60   1    =  l.NUNIT 
PRECIP    *  PPTNRH 
EVAPTR   =  ETO(NOAY) 

C  IF  NECESSARY,   ADJUST  THE   PREC 1 P 

IFISEEDYRIll    -   YEAR)  40,40,50 
40   IFI SEEDYR 121 . LT. YEAR. OR. SEEDAT ( 1  I .GT. NO AY. OR. SEEDAT ( 2 ) .LT .NDAY )  GO 
1   TO  50 
PRECIP  =■  PRECIP  *  SEOINC 
50  PRECIP  =  PRECIP  •  RDIST(I) 
CANREF  =  REGROW  (2,1) 
CONAV  =  REGROWIl.II 

CALL   WATBAL    ICALDEFII), CDMA X,COVOEN(I), DREADY (I),  ENGB AL  III. 

1  FREWATI I  1 , LASUSD 1 1 ) , NDYSNO ( 1 1 , ONTRES ( 1 1 .PHASE  I  I ) , PREWEQ ( 1 1 , 

2  RECHRGI I  I , SIMTHl II ,1 ) , SIMTHl 12, 1 ) .SIMTHl (3, 1 ) , TCOEFF ( 1 1 , 

3  TMPMLT, TRSHLD, VEGTYP, WILTPT) 
C  STORE  THESE  RESULTS 

WE ( NDAY )    ■   WEINOAY)    ♦    IPREWEO(I)    •  RUWTIIll 

ROINOAY)   =  ROINOAY)   ♦   (GENRO  •  RUWT (II) 

YRT0TI2I   =  YRT0TI2)   ♦   (PRECIP  •  RUWTIIll 

YRT0TI3)    -  YRT0TI3)   ♦   (EVAPTR  «  RUWTIIll 
60  CONTINUE 

YRT0TI1I   -  YRTOT II)   ♦  ROINOAY) 
C  WATCH  FOR   THE  HANOATORY   ISOTHERMAL  OATE 

IFI ISOTRH   -   NDAY )  90,70 
70  DO  80  I   -  l.NUNIT 

OREADY ( I )  =  -1 
80  CALDEFII)  »  0.0 
90  CONTINUE 

RETURN ' 

END 


Subroutine  SLIST 


SUBROUTINE   SLIST  (YRALT1 

C  LIST  THE  MANAGEMENT  STRATEGY 

C0HM0N/M/ALTYRI8) , BOUND (6 ,8 ) ,C ALOEF ( 8 ) , COVOEN! 8 ) , CUT ( 8  I , 

1  DEC  I  OS  I  2, 8) ,DREADY(8) .ENGBAL 18  > ,EXPK I  8  I ,EXPK1 1  8 ) , FREWATI 8 ) .LAST  1, 

2  LASUSDI 8) ,LC0PY(14) .N0YSN0I8) , NEXTYR.NPLAN, NUH.NUNI T .ONTRES I  8 ) , 

3  PARAHI9),PHASEI8) , phi  SOI  8  I .PREWEQIS) .RDISTI8) .RDMAX 1 8  I .RECHRGI 8 ) , 

*  REGR0WI2,S) .RUNUMI8) , RUWT (8) ,SEDI NC .SEEDAT I  2 1 , S EEDYRI 2 ) , 
5   SIMTHl (3,8) .TCOEFF IB) .TYPCUT (8  I 

INTEGER  ALTYR, BOUND, DREADY, PHASE, RUNUM, S EEDAT , SEEOYR , TYPCUT 
COMMON/S/AVSOILI 11) .DECLINI 11) .NROADS .RATNRH ( 1 1) , ROADMl ( 11), 
1  ROAOWI  11)  .TANCUT(ll)  iTANFILMll  .TANRHOI  11  )  .YRCNSTI  11) 
INTEGER  YRCNST 

C0HM0N/UT1LTY/BL0CKI18B9),CHANGR,CHANGW,0ATE(2),DATES(«),LINES, 
1  NAHE, NDAY, RCHRGO.ROI 3  721  .WE (372  I , WEO , YE AR , YRTOT ( 3  I 
INTEGER  DATE, DATES, YEAR 

01  HENS  I  ON  BIMNTHI 6) , ETO (3 72) , PPT ( 372 ) , RADI  372 ) , TMAX I  372 ) , TM IN ( 372 1 
EQUIVALENCE   ( BLOCK ( 2 ) , THAX ( 1  I  I ,( BLOCK ( 37*1 .THIN ( 1 ) I . ( BLOCK ( 7*6) , 

1  PPTI 1 ) I . I  BLOCK  I  1118) ,RAD(1I I , ( BLOCK  I  1*90 1 .ETOI 1 ) ) , I  BLOCK  I  186* I , 

2  CDMAX) , (BLOCK!  18651  .VEGTYP) , (BLOCK (1866  I .TRSHLD), (BLOCK!  18671, 

3  THPMLTI , I  BLOCK (1868) , W I LTPT I , ( BLOCK ( 187 1 1 , OCOH AX  I , I  BLOCK  I  18721, 

*  ISOTRMI , (BLOCK!  1873), PEKDAT), (BLOCK!  1880) , BIMNTHI 1 1  I, 
5   (BLCCKI 1986) .PEAKWE) , IBLOCKI1888) .PEAKROI 

INTEGER  PEKDAT, VEGTYP 
INTEGER  YRALT 
IPRINT  =  0 

C  CHECK  FOR  CLOUD  SEEOING 

IFIYRALT  -    SEEDYRIlll  20,10 
10  CALL   GDATE    I  SEED AT ( 1 ) , OAT ES ( 1 ) ) 
CALL  GDATP   ( SEEDATI2I ,DATES(3I I 
WRITF    (18,910)    SEEOYR, SEDINC, DATES 
91C  FORMAT(*0!N  YEAR«I*,«  AND  THROUGH  YEAR«I4,*,   CLOUD  SEEDING  HULT1PL 
1IES  PPT  8Y*F5.2,»  BETWEEN* I  3 , »/» 1 2 , *  AND*I 3, »/•! 2, *.• I 
I  PR  I  'IT  =  1 

C— — -CHECK    THE    YEAR    OF    THE   MANAGED  RESPONSE  UNITS 
20  IFINUNIT  -  2)  8C3O.30 
30  DO  70   I   =  l.NUNIT 

IFIYRALT  -  ALTYR(II)   70, *0 
*0  IPRC'IT   =   (CUTIII   »   100.  I   *  0.5 

IFIIPRINTI   50, 6'^ 
5G  WRITE   (  18,920)  RUNUM ( I ) , RUWT 1 1 ) , I PRCNT 
920  FORMAT  I 13X*0N  RESPONSE   UNIT*I6,«   (AREA  WEIGHT  = «F5 . 2 , « I , • 1 4 , •  PERC 
1ENT  OF  THE  CURRENT  COVER  DENSITY  WAS  REMOVED.* I 
GO  TO  70 

60  WRITE    118, 93C)   YR AL T , RUNUM ( I  I ,RUWT I  I ) , I PRCNT 
930  F0RM.4T(*0JN   YEAR*!*,*   ON  RESPONSE  UNIT*I6,»    (AREA  WEIGHT  =*F5.2,») 
1,*I4,«  PERCENT  OF  THE  CURRENT  COVER  DENSITY  WAS  REMOVED .* ) 
I  PRINT    =  I 
7C  CONTINUE 

C  CHECK   FUR   ROAD  CONSTRUCTION 

80  IF(NKCMOS)  90,150 
90  DO    14?    I    =   1, NROADS 

IFIYRALT  -   YorNST(I))  140,100 
100  IPRC'iT   =.   (TANRHOI  I)   •  IOC.)   ♦  0.5 

IFI I  PR  INT  I  120,110 
110  WRITE    (18,94^1    YRALT, ROAOHI ( I  I .ROAOWI I ) , IPRCNT 

94C   FORM<\T(»OIN   YFAR«I4,»   ROAD   CONSTRUCTION   CRE  ATE0*F6 .  I ,  *   MILES   OF  RO 
IAD  AVCPAS1NG*F5.1,»   FEET  WIOE  THROUGH  AN   AVERAGE  SIOESLOPE  0F»I3, 
2  »  PERCENT.*] 
IPRINT    =  1 
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go  m  i 
120  WRITC  ( 
950  FORMAT! 

1G*F5.1. 
130  IPRCNT 

JPRCNT 

writ:  I 

960  FOPIiAT! 
INT,  PES 
20N  PATE 
3ERDSIPN 
4R0S!  0' 
140  CONTINU 
150  RETURN 
END 


IB, 95  0  I    R0ADM1 ( I ) , ROADW ( I  I , I PRCNT 

13X«R0AD   CONSTRUCTION  CRE ATED*F6 . 1 , *   MILES   OF   ROAD  AVERAGIN 
*   FEET  WIDE   THROUGH  AN  AVERAGE   SLOPE  0F*I3,*  PERCENT. »l 
=   (TAMCUTI I  I   *   100. I    ♦  0.5 
=    I TANFIL I  I  I    *    100. )    +  0.5 

18, 960)    I  PRC  NT, JPRCNT , RATNRM I  I ) , AVSOI L I  I ) , DECL I N (  I ) 
1 A X* THE   SLOPES   OF  CUT  AND  FILL  AV ER AGED» ! 3 , *  ANO* I  3, *  PERCE 
ECTIVELY.      THE    ESTIMATE   OF   THE   LONG-TERM   NORMAL */ 14X*ER0 S I 
WAS*F7.2,«,    THE   INDEX  OF  THE   AMOUNT   OF   SOIL   AVAILABLE  FOR 
WAS«F7.2,»,   AND  THE   INDEX  OF   THE */ 1 4X*RAT E  OF  DECLINE  OF  E 
FOLLOWING   DISTURBANCE   W  AS*F7  .  2  ,  *  .  *  I 


Subroutine  TITLEM 


10 
922 

923 

924 

925 

926 

927 


930 
931 


940 

941 

942 
30 
950 

951 

952 


SUBROUTINE  TITLEM 
-PRINT   THE    TITLE  SHEET 

COMMON  OA  TIME (2  I  .DEC  MA L , NRMANG , NS AVED . NY  EARS , PLNOPT ( 1 9 ) , PLUN I T ( 6 ) , 
1   REC0VR,REGI0N(8) ,REGOPT I  5 ) , S AVE , S EDRN2 , WE IGHT 

INTEGER  DATIME,PLN0PT,PLUNIT,PEC0VR,REGI0N,REG0PT»SAVE»SEDRN2 

COMMON /M/AL TYR! 8  I .BOUND  16,8) ,CALDEF ( 8 ) ,COV0£N( 8  I .CUT  I  8  I , 

1  DEC 10S1 2,8) ,QRE A0Y(8) , ENG8AL ( 8 )  , EX PK I  8  I , E X PKl ( 8  I , FR 6w AT  I  8 ) , L AST  1 , 

2  LASUSDI 81  ,LC0PY(14I  ,NDYSN0(8) , NEXT YR , NPL AN, NUM , NUN  I T , ONTR ES ( 8  I ■ 

3  PAR  AM | 9  I .PHASE  I  8 ) , PH I SQ{ 8 ) , PREWEQ1 8 ) ,R0 1ST ( 8  I ,RDMAX I 8) .RECHRGI 8 )  , 

4  REGROWI 2. 8) ,RUNUM( 8) ,RUWT ( 8 ) ,SEDI NC , SEE  DAT ( 2 ) , SEFDYR1  2) , 

5  SIMTMH3.8)  ,TC0EFF(8I  .TYPCUTI8) 

INTE  GER  AL TYR, BOUND, OR EADY, PHASE, RUNUM, S EEDAT , SEEOYR, TYPCUT 
C0MM0N/TIME/CANREF,CDMAX2,C0NAV 

COMMON /UTILTY /BLOCK (1889) , CHANGR , CH ANGW , D ATE ( 2  I , DAT  ES ( 4  > . L INES . 
1  NAME , NDAY.RCHRGO.RO (372  I  ,  WE ( 372  ) , WEO , YE AR , YRTOT ( 3  I 
INTEGER   DATE .DATES, YEAR 

DIMENSION  BIMNTHI 61 , ETO ( 372 1 , PPT ( 372 ) ,RAD ( 372 1 ,TMAX( 372 ) ,TMIN( 3721 
EQUIVALENCE    (BLOCK! 2) ,TMAX( 1  I  I  , (BLOCK (374) ,TMIN( 1) ) , ( BLOCK! 746  I. 

1  PPT (1  I  I , (SLOCK (11181 , RADII ) )  , I  BLOCK  1 1490 ), ETO ( 1  I ), ( BLOCK ( 1864), 

2  CDMAX) , ( BLOCK ( 1 865  I .VEGTYP I , (BLOCK  I  1866 ) , TRSHL01 , I  BLOCK (  1867) , 

3  TMPMLT ) , I  BLOCK ( 1868) ,WI LTPT I , ( BLOCK ( 1871 1 , DCDMAX I , (BLOCK!  1872 ) , 

4  ISOTRMI , (BLOCK!  18731 , PEKDAT ) , ( BLOC K (  1 880  I .BIMNTHI II  I. 

5  I  BLOCK  I  18  86) .PEAK WE ) , (BLOCK  11888) , PEAKROI 
INTEGER   PEKDAT . VEGTYP 

WRITE   (6,910)  PLUNIT.DATIME 

FORMAT  I *1*6A10. 52 X2A1 0/11 5X» ALTERED  CONDITIONS*) 
RUNUMU)    =    10H  NATURAL 
WRITE   16,920)    IRUNUMII I ,I=1,NUNIT) 
F0RMAT(*0RESPONSE   UNIT  NUMBER«1 OX A10 , 7  I  1 0 ) 
RUNUM I  11=0 

WRITE   (6,921)    (RUWT ( I  I , 1=1 ,NUNIT) 
FORMAT(*0PERCENT  OF   PLAN  UN  I T« 10X8F 10 . 2 ) 
IFINUNIT  -  2)  20,10,10 
WRITE   (6,922  )    (ALTYRII > ,I=2,NUNITI 
FORMAT!*  YEAR  OF   CUT  *20X7I10) 
WRITE    16,923)    ICUTI I  I ,I=2,NUNIT) 
FORMAT ( *  PERCENT  OF  CUT  *20X7F10.2) 
WRITE   16,924)    (ROISTII ) ,1=1 ,NUNIT) 
FORMAT!*  PRECIP  REOIST  F ACTOR*10X8F 10 . 2 ) 
WRITE   (6,925)    ( BOUND! 5 , I ) , I =2 ,NUNI T ) 

format i *     Change  starts  in  *20x7iioi 

WRITE    16,926)    I  BOUND (6,I),1=2,NUNIT) 
FORMAT!*        CHANGE   ENDS    IN  *20X7I10I 
WRITE   16,927)    I REGROWI 1 ,1 ), 1 =2 ,NUNI Tl 
FORMAT!*  REGROWTH-AVAIL  WATE R*20 X7F10 . 2 ) 
WRITE    16.925)    (BOUND! 1,1  I , I=2,NUNIT I 
WRITE    (6,9261    (B0UND(2,I1 ,I=2,NUNIT) 
WRITS   (6,928)    I  RE  GROW  I  2 , 1 ) , I =2 , NUN  I T ) 
FORMAT!*   REGR0WTH-REFLECTIVTY*2  0X7F10.2I 
WRITE    16,925)    I  BOUND  I 3,I),I  =  2,NUNIT) 
WRITE   16,926)    ( BOUND  I  4 ,I),I=2,NUN1T) 
WRITE   16,930)    ( TCOEFF 1  I ) , 1  =  1 ,NUNIT) 
F  OR  MAT  1  *    TRANSMI SSI VITY  COEFF* 10X8F 10 . 2 ) 
WRITE   16,9311    (C0VDEN1 I  I ,I  =  1,NUNITI 
FORMAT!*   COVER  DENSITY  *10X8F10.2) 
TMPMLF    =    (TMPMLT   *    1.8)    ♦  32. 

WRITE   (6,9321   CDMAX, VEGTYP ■ TRSHLD, TMPMLF .WILTPT 
FORMAT ( *  MAXIMUM  COVER   DEN  *10XF10.2/ 

1  *  VEGETATION  TYPE  *10XU0     /*  REFLECTIVITY   THRS  HL  D*  10XF  10 . 2/ 

2  *  MELT  THRESHOLD  *10XF10.2/»  WILTING  POINT  *10XF10.2) 
IFIVEGTYP.NE.3)   GO  TO  30 

WRITE    16,9401    IDECIDSIl ,1 ) , I=1,NUNIT) 
FORMAT!*  DECIDUOUS   WINTER   TC  *10X8F10.2I 
WRITE   (6,941)    (DECIDS12.il ,I=1.NUNIT) 
FORMAT!*  DECIDUOUS  WINTER  CD  *10X8F10.2) 
WRITE    (6,942)  DCDMAX 

FORMAT ( *   DECIDUOUS   WNTR    C DMAX*1 0 XF 10 . 2 ) 
WRITE    (6,950)    ISIMTMII2, I ) , I=l,NUNIT I 

FORMAT! *OINI TI AL   CONDITIONS*/*   AVERAGE    PACK   TEHP.  *10X8F10.2) 
WRITF    (6,951)    IPREWEOII) ,I=l,NUNIT) 
F0RM1TI*   PACK   WATER  EQU1V.  *10X8F10.2I 
WRITE    16,952)    (RECHRGI I ) , I=1,NUNIT) 
FORMAT ( *  RECHARGE  R EOUI RE  ME  NT* 1 0X8F 1 0 . 2 ) 
IF(SEEDYRIl)   -   9999)  4C50 
CALL   GDATE    I SE E DAT  I  1  I , DAT E S 1 1  I ) 
CALL   GDATE    I SEEOAT I  2  I , DATE S I  3 ) ) 
WRITE    16,960)    SEEDYR, DATES. SEDINC 

FORMAT  I *CCLOUD    SEEDING   FROM   *I4.«  TO   *I4,*,    DAYS   *I2,«/*I2,*   TO  * 
1    I2,*/*I2,«,   WITH  A  FACTOR  OF  *F6.2I 
RETURN 
END 


Subroutine  BALANC 


INTEGER   AL TYR, BOUND, ORE ADY, PHASE, RUNUM, SEE  DAT, SEEDYR, TYPCUT 
IFINUNIT  -  21  10,20,20 
10  RETURN 

C  ACCUMULATE    THE    WEIGHTS   FOR    THE    AREAS   ON   WHICH   THERE  IS 

C   REDISTRIBUTION   WHILE   CALCULATING   THE    REMAINING   PORTION    FOR  THE 

C  OTHER  AREAS 

20  RDSTwT  =  CO 
REMAIN  =  l.C 
DO   40   N   =    2  » NUN  I T 
IF! TYPCUT ! N ) )  30,40 
30  RDSTWT  =  RDSTWT  ♦  RUWTIM 

REMAIN   =   REMAIN   -    I R  D I  ST  I N )    «  RUWTIN)) 
40  CONTINUE 

IFIABSIREMAINI.LT. 0.01)   REMAIN  =  0.0 
IF(REMAIN)  50,60,60 
50  WRITE  (6,9101 

910  F0RMAT(*1THE  REDISTRIBUTION  OF  THE   PRECIP  TOTALS  MORE  THAN   100  PER 
1CFNT  -  JOB  ABORTED*! 
CALL  ABORT 

C  CALCULATE   THE  CORRESPONDING  EFFECT   UN  PRECIP  FOR  THE  NATURAL  UNIT 

C   AND  THOSE   WHERE   REDISTRIBUTION  WAS  NOT  SPECIFIED 

60  REST    =    1.0  -  RDSTWT 

IF(REST)  70,70,80 
70  EFFECT  =  CO 

GO  TO  90 
80  EFFECT   =  REMAIN/REST 

C  DEFINE   THE   REDISTRIBUTION  FACTORS  FOR  THOSE  AREAS 

90  DO   110  N  =  l.NUNIT 

IFITYPCUTINI )  110.100 
100  ROIST(N)    =  EFFECT 
110  CONTINUE 
RETURN 
END 


Subroutine  GBOUND 


SUBROUTINE  BALANC 
—BALANCE   THE   REDISTRIBUTION  FACTORS 

COMMON /M/ALTYR( 8)  , BOUND  I  6 , 8  I  .C ALOEF ( 8  I  . COVDENI 8 )  ,CUT(B), 

1  DECI0SI2,0),DRfcADYI8),ENG8ALI8),EXPK!8),EXPKl!8l,FREWAT(8l,LASTl, 

2  LASUSDI 81  ,LCOPY( 14  I  , NDYSNO ( 8 ) , NEXT YR , NPL AN, NUM, NUN  I T , ONTRE S I  8  I , 

3  PAR AM  19 ) , PHASE! 8  I , PH I SQ I  8  I , PRE WEO 1 8 ) , RO I  ST ( 8 ) ,ROMAX 1 8) .RECHRGI 8  I . 

4  REGROWI 2. 8) , RUNUM I B I ,RUWT I8I,SEDINC.SEEDAT(2I .SEEDYR ! 2 ) . 

5  SIM TM1 I  3,8)  .TCOEFF (8)  .TYPCUT 18) 


SUBROUTINE  GBOUND  IN) 

C  GET   THE   BOUNDARY  YEARS  -   (IF   NOT   SPECIFIED,   USE  THE  ASSUMED 

C   VALUES) 

COMMON /M/ALTYRI 8) , BOUND (6,8) , C ALOEF 1 8 )• COVDENI 8  I ,CUT( 81 , 

1  DEC  IDS! 2 ,8  I , DREAOY 1 8 ) , ENGBAL I  8 ) , EXPK I  8 ) , E XPK 1 1  8 ) , FR E WAT  I  8  I , LA ST1 , 

2  LASUSDI 8) ,LCOPY( 14) .N0YSNOI8) .NEXT YR , NPLAN, NUM, NUNI T , ONTRES I  8  I . 

3  PAR  AMI  9  I , PHA  SE I  8 ) . PHI SQ I  8 ) .PREWEQI8) , RD I  ST  I  8 ) , RDMAX I  8 ) , RECHRG 18), 

4  REGROWI 2, 8  I , RUNUM! 8) ,RUWT(8) , SED! NC , SEEDAT I  2  I , S EEDYR I  2 ) , 

5  SIMTM113.8) .TC0EFF18I , TYPCUT ( 8  I 

INTEGER  AL TYR, BOUND, DREAOY, PHASE, RUNUM, SEEDAT, SEEDYR, TYPCUT 
COMM0N/TIME/CANREF,CDMAX2,C0NAV 

COMMON /UT I LTY/BLOCKI 1889) , CHANGR , CH ANGW , DATE ( 2 ) , DATES14) .LINES, 
1  NAME, NDAY.RCHRGO.RO I  372  I .WE (3721  ,WEO, YEAR. YRTOT (3) 
INTEGER  DATE, DATES, YEAR 

DIMENSION  BIMNTHI 6) , ETO 1 372 ) , PPT  I  372  I , R ADI 372 ) , TMAX I  372  I , TM I N I  372 ) 
EOUI VALENCE    (BLOCK  I  2) .TMAX! 1  I ) , I  BLOCK (374) ,TMIN( II ) . (BLOCK! 7461, 

1  PPT  I  I )), (BLOCK! 1118) .RADII  I ) , I  BLOCK  I  1490 1 ,ETO( 1 ) I , I  BLOCK ( 1864), 

2  CDMAX I , (BLOCK (1865  I .VEGTYP I , (BLOCK  I  1866 ), TR SHLD ),( BLOCK  I  1867), 

3  TMPMLT  I  ,  (BLOCK!  1868)  .WILTPT)  ,  I  BLOCK  I  187 1 1  ,  DCDMAX  ),(  BLOCK  ( 1 872 )  , 

4  ISOTRM I , 1  BLOCK!  18731  .PEKDAT)  . ( BLOCK  1 1880) .BIMNTHI II  I, 

5  I  BLOCK  I  18861  .PEAKWEI , I  BLOC K 1 1888  I . PEAKROI 
INTEGER  PEKDAT, VEGTYP 

INTEGER  YR  PAST 

DIMENSION  ASSUMD(7,3I 
C  LOOGEPOLE  PINE 

DATA  ASSUMDd.l)  ,ASSUMD(2,1 )  ,ASSUMD(  3, 1)  ,  ASSUMOt  4, 1 1 ,  ASSUMo  (  5, 1 )  , 
1  ASSUMO  ( 6, 1 1,  ASSUMD!  7, 11/15.,  80., 0., 40.,  40.,  120., 0.0/ 
C  SPRUCE-FIR 

DATA  ASSUMD ( 1 ,2) , ASSUMD (2,2) .ASSUMD (3, 2) , As SuMDI 4 , 2  I , ASSUMD!  5, 2 1 , 
1   ASSUMD I  6, 2) , ASSUMD 17, 2 1/30., 100., 0., 80., 80., 160., 0.0/ 
C  ASPEN 

DATA  AS  SUMO  I  1 ,3) .ASSUMD 12 ,3) .ASSUMD 13.3)  , ASSUMD I  4 , 3 ) . ASSUMD! 5,3), 
1   ASSUMD (6,31 .ASSUMD I  7, 3 1/7. ,60 . ,0 . , 20 . , 20 . . 80 . . 0 .0/ 

C0MAX2  =  CDMAX/2.0 

C  IF  THE  CUT   IS  LESS  THAN  50  PERCENT,    IT   IS  ASSUMED  THAT  THE 

c   PATCH  CUT   TRANSITION  LEVEL  OF   THE   FOREST  IS  ZERO 

I F I C  DMA  X2  -  C0VDEN1NI)  10,10,20 
10  BOUNDIl.N)   =  ALTYRIN)  -  1 

BOUN  D I  2 , N )    =  BOUNDIl.N) 

B0UNDI3.N)   =  BOUNDIl.N) 

BOUND  1 4 . N )    =  BOUNDIl.N) 

BOUND  I  5  » N)    =  BOUNDIl.N) 

BOUN D I  6, N)    =  BOUNDIl.N) 

RDM A  X 1 N )    =  0.0 

RDISTINI    =  1.0 

TYPCUT(N)   =  0 

RETURN 

C  USF    THE    ASSUMED   VALUES    IF    ALL   PARAMETERS    ARE  BLANK 

20   DO   40    I    =  1,6 

IFIPtRAMI 1*2) )  50,30 
30   BOUNDIl.N)    =   ASSUMD! I .VEGTYP) 
40  CONTINUE 

ROMAXIN)    =   ASSUMDI7, VEGTYP) 

GO  TO  70 

C  SINCE   AT  LEAST  ONE   OF   THE   PARAMETERS  WAS   SPECIFIED,   USE   THEM  ALL 

50  DO  60   I   =  1,6 

BOUND  I  I , N )    =  PARAMII*2) 
C-  CERTIFY  THAT  THE   ENDING  YEARS  FOLLOW  THE   BEGINNING  YEARS 

IF( I  .EO.l.OR. I .EQ.3.0R. I .EQ.5)   GO  TO  60 

IF (BOUND! 1-1 ,N) .LT. BOUND! I ,N) )   GO  TO  60 

WRITE   (6,910)   ALTYR IN) .RUNUMI N) , BOUND! I . N) , BOUND! 1-1 ,N) 
910   FORMAT(*OMANAGEM£NT   PLAN  CARO   ERROR   -   YEAR*I4,»,    RESPONSE  UNIT*I6, 
1   *,    ENDING  YEAR*I4,*  DOES   NOT  FOLLOW  BEGINNING  YEAR*I4,*  -  JOO  ABO 
2RTED*) 
call  abort 
60  continue 

r  dma  x i n )  =  rarami9) 

c  oefine  phi  squared  for  the  reflectivity  and  cover  density  function 

70  phisqini  =  ib0undi4.n)  -  b0undi3,nii  «*  2 

c  1 f  this  is  »  thinning  cut  rather  than  a  patch  cut,  adjust  the 

c   boundaries  to  compensate  (this  allows  the  removal  of  the 

c          overstory,  but  leaves  a  stand  which,  in  terms  of  the  simulation 

c          functions,  is  already  in  the  process  of  regrowthi 

if  icuvd:nco  )  100,100,80 
80  yr  p a  st  =  sort  ((cdvden(n)  •  ph i sq ( n i ) / cdm ax  i  ♦  0.5 

no  13  !   =  1,6 
90   BOUNDIl.N)    =    BOUND!  I, Nl    -   YRP  AST 
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C  DEFINE   TMF   80UNDAP I E S   IN  TERMS  OF   THE  YE»B  OF  TREATMENT 

100  DO   110   I   -  1.6 

110   fOUNOII.NI    -    BOUNOII.NI    »  ALTYRINI 

C  COMPUTE    THE   K   FOR   THE    INVERSE   EXPONENTIAL   FUNCTION  REPRESENTING 

C   THr    AVAILABLE    SOIL   WATER  FACTOR 

C  CIVr'N   THAT   TAU  "   N»S  XP  ( -K  •  I  T-TC  I  I  ,   AT  TIME  T   "  FULL  REGROWTH,  TAU 

C  BECOMES  M/2  .  THUS. 

c   »/J    ,   M*EXP(-K* ( T-TCI ) .    WHICH  YIELDS 

C   1/7   =  EXP l-K»IT-TC) I .     UPON  TAKING  THE   NATURAL  LOG. 

C   LN( ■ 5 I    "   -K«(T-TCI .  OR 

C  —   K    »   -LNI .51/11   -    TC I 

EXPK(N)    *  0.6931471905/FLOAT I BOUND I 2.N)   -  eOUNOII.NI) 

c  COMPUTE   THE  K  FOR  THE   INVERSE  EXPONENTIAL  FUNCTION  REPRESENTING 

C   THE   PR=C!°  REDISTRIBUTION 

C  GIVEN  THAT  RhO   =  RHOIMAXI   •  EXP   I -Kl • I T-TC ) I .   AT  TIME  T   -  FULL 

C   REGROWTH,  SHO  MUST  APPROACH  2ER0  ( ASSUME  1  PERCENT ) •  HENCE. 

C   .01  -  RHOIMAXI   •  EXP  I -Kl* ( T-TC 1 1  *  OR 

C   .Ol/PHOIMAXI   •  EXPI-Kl»IT-TC>>.     UPON  TAKING  THE  NATURAL  LOG. 

C  LNI  .n/RHOIMAX)  I   ■  -K1»(T-TC),  OR 

C   Kl    «   -LNI .Cl/RHOINAXI 1/ I T-TCI      IWATCH  FOR   RHOIMAXI    •  0) 

1FIR0MAXINII  130,120.130 
120  80UNOI5.NI    ■   ALTYR(N)   -  1 
B0UND16.NI   -  ALTYRINI  -  1 
RETURN 

130  EXPK1INI    =  -   AL0GI0.01/A8SIRDMAXIN) ) l/FLOATI BOUND! 6.NI-B0UNDI5.NI) 
TYPCUTIN1   -  1 
RETURN 
END 


Subroutine  TRENDS 


SUBROUTINE  TRENDS 

C  DETERMINE   THE   EFFECTS  OF  THE   TIME  TREND! S ) 

C0MM0N/M/ALTYRI8I. BOUND  1 6. B ) . CALOEF 1 6  I .COVDENI 8  I .CUT  I  8) . 

1  DEC  ins  I  2. 8 1 .DREADYI8I .ENGBALI8I .EXPKI8I .EXPK1 1 8 1 .FRENAT I  8 1 . LAST1 . 

2  LASUSOI 81 , LCOPY 1 14) .NDYSN0I8I ,NEXTYR,NPLAN,NUM,NUNIT,0NTRESI8I, 

3  PAR  AMI  9 1 .PHASE (81 . PHI  SOI  8 1 . PREWEQ 1 8 1 . RD 1ST  I  8 1 , RDMAX I  6 1 . RECHRGI 8  I . 
6  REGROWI2.8l,RUNUH(BI.RUWTI8l,SE0INC,SEE0ATI2l,SEE0VR(2l, 

5  SIM TM 1(3. 81 . TCOEFF I  8 1 . TYPCUT (8  I 
INTEGER  AL TYR .BOUND .DREAD Y. PHASE .RUNUM.S EEOAT . SEEDYR. TYPCUT 
COMMON/ T I  ME /CANREF. CDMA X2.C0NAV 

COMMON/UTILTY/BLOCK! 1889)  .CHANGR.CHANGW.DATEI 2  I .DATESI4I .LINES. 
1  NAME, NOAY.RCHRGO.RO I  3721  ,WE (372) ,WEO, YEAR, YRT0TI3) 
INTEGER  DATE, OATES, YEAR 

DIMENSION  BIMNTHI6) .ET0I372I , PPT  1 372 1  ,RAOI 372 1 .TNAX I  372 1, TN INI  3721 
EQUIVALENCE   (BLOCK  1 21 ,  TNAX  I II I ,  I  BLOCK  ( 374) ,  TM.INI  1 )  I .  I  BLOCK  (  746) , 

1  PPTIll I , I  BLOCK  1 1118) .RADII) I , I  BLOCK  1 1490) . ETO 1 1 ) ) . I  BLOCK! 1 B64 1 , 

2  COM AX  I , I  BLOCK  1 1865 ) .VEGTYP) , I  BLOCK  1 1866  I .TRSHLD) . ( BLOCK  1 18671, 

3  TMPMLT) , I  BLOCK (1868) .WILTPTI , I  BLOCK  1 18711 .OCDMAXI. I  BLOCK!  1872), 

4  I SOTRM I , ( BLOCK! 1873) , PEKOAT ) , I  BLOCK! 1880) , BIMNTHI 1 1  I, 

5  t BLOCK  1  1886) , PE AKWE ) , I  BLOCK  1 1888 ) , PEAKRO) 
INTEGER  PEKOAT, VEGTYP 

IFINUNIT  -  21  10.20,20 
10  RETURN 

20  DO  170  N  •  2. NUN  I T 

C  AVAILABLE  SOIL  WATER  ADJUSTMENT   (ACCOUNTS  FOR  INCREASED  CANOPY 

C   OENSITY  AND  ROOTING  DEPTH) 

C  REGROW(l.N)  WILL  BE  -CONAV- 

IFIYEAR  -  B0UNDI1.NI)  30.30,40 

C  THE  CUT  AREA  IS  STILL  TO  BE  CONSIDERED     AS  AN  OPENING 

30  REGROWIl.N)  •  1.0 
GO  TO  70 

40  IFIB0UNDI2.N)  -  YEAR)  50,50,60 

C  REGROWTH  IS  COMPLETE  AS  FAR  AS  THIS  FACTOR  IS  CONCERNED 

50  REGROWI 1,N)  »  0.5 
GO  TO  70 

C  REGROWTH  HAS  OCCURRED,  BUT  IS  NOT  COMPLETE 

60  REGROWIl.N)   •  EXP  I-EXPKIN)   •  I  FLOAT  I  YEAR  -  BOUND! 1,N ))) ) 
WRITE  117,9101  YEAR, RUNUMINI , REGROWIl.N) 
910  FORMAT!*  AFTER  THE  GROWING  SEASON  OF  WATER  VEAR*I4»*  ON  RESPONSE  U 
1NIT*I6,*,  THE  AVAILABLE  WATER  FACTOR  IS*F5.2) 
— CANOPY  REFLECTIVITY  ADJUSTMENT  AND  COVER  OENSITY 

C  REGROWI 2, N)  WILL  BE  -CANREF- 

70  IF(B0UND(4,N)  -  YEAR)  80.90.90 

 REGROWTH  IS  COMPLETE  AS  FAR  AS  THE  CANOPY  REFLECTIVITY  IS 

  CONCERNED 

80  REGR0W(2,NI   •  1.0  -   10.5  •  EXPI-1. 609437912  •  COVDENINI/COMAX) ) 

GO  TO  120 

 REGROWTH  HAS  OCCURRED.  BUT  IS  NOT  COMPLETE 

 GIVEN  THAT  RF  •   RFO  •  EXP   I -OMEGA*COMAX*T**2/PHt**2 ) ,   AT  TIME  T  " 

  PHI,     RF  ■  RFO  •  EXP  l-OMEGA»COMAX).     AT  TIME  PHI,  THE  MAXIMUM 

  COVER  OENSITY  HAVE  BEEN  REACHED.     HENCE,  RF  *  0.1   IRFO   IS  A 

  CONSTANT  0.51,  WHICH  YIELDS 

  0.1  •  0.5  •  EXP  I -OMEGA  •  COMAX),  OR 

  0.2  ■  EXP  ( -OMEGA*CDMAX) •     UPON  TAKING  THE  NATURAL  LOG, 

  LNI 0.2)   «  -OMEGA  •  COMAX ,  WHICH  YIELDS 

  OMEGA  -  -  LNI0.2I/C0MAX.     SUBSTITUTION  PRODUCES 

  RF  *  0.5*EXP  l-1.609«T««2/PHI»«2l. 

  THE  VARIABLE  -CANREF-  IS  DEFINEO  TO  BE  1  -  RF 

90  I F ( YEAR  -  80UN0I3,N>)  100,100,110 

C  THE  CUT  AREA   IS   STILL  AN  OPENING 

100  RFGR0WI2.N)  «  0.5 
GO  TO  120 

110  T8YPHI   >   I  FLOAT ( YEAR  -  BOUND  I  3 , N I  I «»2 ) /PHI SQ ( N I 

REGROWI  2,N )  •  1.0  -  (0.5  •  EXP  1-1.609437912  •  TBYPHDI 
COVDENINI   =  COMAX  •  TBYPHI 
TCOEFF ( N )    =   TC  (COVDENINI) 

WRITE   117,920)  YEAR, RUNUMINI, REGR0WI2.NI .COVDENIN) 
920  FORM  AT  I  *  AFTER  THE  GROWING  SEASON  OF  WATER  YEAR«I4,«  ON  RESPONSE  U 
1NIT*I6,*,   THE  CANOPY  REFLECTIVITY  FACTOR   IS»F5.2,»,   COVER  OENSITY 
2IS«F5.2) 

IFIVEGTYP.NE.3.AN0.VEGTYP.NE.4)  GO  TO  120 

DSCIDSI2,NI    =   OCDMAX   •  TBYPHI 

nECIDSIl.M   »  TC  IDECIDSI2.N)) 

WRITE   (17,9301  DECI0SI2.N) 
930  FORMAT ( *      WITH   A   WINTER   COVER   OENSITY  OF»F5.2l 

C  REOI STRIBUTION 

120   I F ( YrAR   -   B0UND(5,NI)  130,140,140 

c  maximize  redistribution 

13c  rdistini  ■=  1.0  »  romaxini 

go  to  17: 

140  ifib0undi6.ni  -  year)  150,150,160 

c  REGRnwTH  IS  COMPLETE 


150  RDISTINI   ■  1.0 
TYPCUTINI   *  0 
GO  TO  170 

C  ADIUST   TIIF  REDISTRIBUTION 

160  ROISTIII)    =    l.t    »    (  RDMAX  I  N  )    «    E XP I -E XPK 1 ( N >    •    FLOAT  I  YE AR-BOUNDl 5, N I 
1)  )  ) 

WRITE    (17,9401    YEAR , RUNUMINI ,RDI ST (Nl 
940  FORM  AT  I  *   AFTCR    THE    GROWING   SEASON   OF   WATER    YEAR»I4,»   ON   RESPONSE  U 

1NIT»I6.«,   THE  PRECIP  REDISTRIBUTION  FACTOR  IS*F5.2I 
17C  CONTINU" 

C  BALANCE    THE    REDISTRIBUTION  FACTORS 

CALL  BAUNC 

RETURN 

END 


Program  SEDMOD 


OVERLAY  (OLAYS.2,3) 

PROGRAM  SEDMOD 
C  SEDIMENT  YIELD  MOOEL 

COMMON  0ATIMEI2I . DECMAL .NRMANG . NSAVED , NY  EARS . PLNOPT I  1 9  I , PLUN I T I  6  I , 
1  RECOVR.RFGIONI B) .REG0PTI5I , S AVE , SEDRN2 . WF I GHT 

INTEGER  DATIME, PLNOPT, PLUNIT.RECOVR.REGI ON, REGOPT, SAVE, SE0RN2 

CC1MM0N/S/AVS0ILC  11  )  ,DECLIN(11I  ,  NROAOS  ,RATNRM(  1 1  I  ,  ROADM 1 1  11 )  , 
1  ROADWI 11), TANCUT 1111 , TANFILI HI . TANRHO I  11  I , YRCNSTI 11) 

INTEGER  VRCNST 

COMMON/UTILTY/BLOCKI 19891  , CH ANGR . CHANGW , OAT E I  2  I , DAT ES ( 4  I , L INES . 
1   NAME, NDAY.RCHRGO.ROI 372) ,WE (3721 , WEO , YE AR , YRTOT ( 31 
INTEGER   DATE, DATES, YEAR 

DIMENSION  BIMNTHI6I ,E TO ( 372  I , PPT ( 372 ) , RAO ( 372  I , TMAX I  372 ) , TM I N I  372 1 
EOUI VALENCE    (BLUCKI2I , TMAX II 1  I , I  BLOCK! 374  I , TM IN  I  1 1 ), I  BLOCK! 746), 

1  PPT ( 1 ) 1 , (BLOCK! 1118) ,RADI II ),( BLOCK ( 1490 1 , ETO ( II  I . I  BLOCK  I  1864  I . 

2  C DM AX  I , (BLOCK!  1865) .VEGTYP) , I  BLOCK  1 1 866  I .TRSHLD), I  BLOCK  1  1867  I , 

3  TMPMLT I , (BLOCK! 1868) .WILTPT) .(BLOCK! 1871) .OCDMAX) . ( BLOCK! 18721, 

4  I SOTRM) , (BLOCK (1873  I . PEKDAT ) , (BLOCK!  1880  I , B 1MNTHI 1)1, 

5  (BLOCK!  1886) , PE AKWE  > , (BLOCK!  18881, PEAKRO) 
INTEGER   PEKOAT, VEGTYP 

DIMENSION  LCOPYI 141 ,NCOL( 1651 ,ONELIN( 11 ) ,S  EDNAT ( 165, 11), 
1  SEDINC(165,ll) 
INTEGER  CODE! 11) .POINT ( 121 ) . YEARS! 165 ) 

C  EOUI VALENCE  ARRAYS  TO  SAVE  STORAGE  REQUIREMENTS 

EQUIVALENCE    I  BLOCK. SEDNAT) , (RO.NCOLI , (WE, YEARS) 

DATA  C0DE/1H1 .1H2.1H3.1H4 .1H5.1H6, 1H7.1H8, IH9. 1HA, 1HB/ 

C  COPY  THE  DESCRIPTION  OF  THE  STRATEGY 

REWIND  18 
GO  TO  3 
1   WRITE    (6,903)  LCOPY 
903  FORMAT! 13A10.A6) 
3  READ   I  18,903)  LCOPY 

IF(E0F(18)I  5,1 
5  REWIND  18 
END  FILE  18 
REWINO  12 

C  OEFINE  THE  COLUMN  COUNTER  ANO  THE  YEARS 

DO  10  I  =  l.NYEARS 
NCOLI I  I   =  0 
10  READ    I  12,906)    YEARSII ) 
906  F0RM4TI2XI3I 

C  CALCULATE   THE   ACCUMULATED  SEOIMENT  FOR  THE  DISTURBEO  AREA  AS 

C   THOUGH  IT  REMAINED  IN  ITS  NATURAL  STATE,  THEN  CALCULATE  THE 

c   INCREASE 

DO   53   I   =   1, NROAOS 

CONST  ■=   (ROADW!  I  1/2.0)   •   TANRHO  1 1  ) 
DISTRB   =  0.121   «  ROADMI ( I )    *   (ROADW(I)  ♦ 

1  (CONST/ (TANFILI  I  )   -  TANRHO(ID)  ♦ 

2  (CONST/ITANCUTI I  I   -  TANRHO! I  III) 
C  PLACE  THIS  YEAR   IN  THE  TABLE 

DO  20  J  =  l.NYEARS 
K   =  J 

IFIYRCNSTIII  -  YEARSIJIl  20,30 
20  CONTINUE 

C  CALCULATE   THE   VALUES  FOR  THE  FIRST  YEAR,   THEN  THE  REMAINING  YEARS 

30   SEONATIK.II    =>   OISTRB   •   RATNRM (  I  I 
CONST  =  OISTRB  •  AVSOILIII 

SEDINCIK.II   =  CONST  »  II. 0  -  EXPI-DECLINI I ) ) ) 
NCOL(K)   =.  I 
L  =■  K  ♦  1 

IFIL.GT.NYEARSI    GO   TO  45 
DECTIM  =  DECLINI I  I 
RATTIM  *  SEONATIK.I) 
DO  40  J   =  L.NYEARS 

SEDNATIJ.I)   =  SEDNAT ( J-l » I  1   ♦  RATTIM 
DECTIM   =  PECTIN  »  DECLINIII 
SEOINC ( J.I )   =  CONST  »  11.0  -  EXP(-OECTIM)) 
NCOL(J)   =  I 
40  CONTINUE 

45  1FII .EQ.ll  GO  TO  50 
L  =   I  -  1 

DO   46   J    =  K.NYEARS 

SEDNATIJ.I)   =  SEDNATIJ.I)   ♦  SEDNAT ( J. L I 

46  SEDlriC(J.I)   =  SEDINCIJ.l)   ♦  SEDINCIJ.L) 
50  CONTINUE 

60  IPASS  =  1 

NAMSED   =   1 OHCUMULAT I VE 

C  PRINT  THE  COMBINED  AMOUNTS ,   THEN  THE   INCREASE  OVER  NATURAL 

C   CONDITIONS 

70  00  120  I   =  l.NYEARS, 55 

WRIT":    (6,910)    PLUNI  T  .DAT  I  ME  ,  NAMSED 
910  F0RMAT(*1«6A1C,52X2A1G/113XA10,«  SED  Y I E LD*/ »0*/ •  YEAR*/) 
Nl   =  I 
N2  =  I   ♦  54 

IFIN2.GT.NYEARSI    N2    =  NYEARS 

on   11C   N  =  Nl  »N2 

IFCICOL(Nl)  90,80 
90  WRITE   (6,920)   YEARS (N) 
920  F(lRfATIlXI5,15XHF10.u» 

GO  TP  110 
90  J I   =  NCOL(N) 

00   LCO   J   =  l.Jl 
100  ONELIMIJ)   =  SEONAT(N.J)   ♦  SEDINCIN.JI 

WRIT"   (6.9201   YEARS1N)  ,  10NELIN!  J),J="1, Jl ) 
110  CONTINUE 
120  CONTINUE 
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C  PR  I  -IT   THE    INCREASE    OVER   NATURAL  CONDITIONS 

DO   16C   I   =   1, NYEARS. 55 
WRIT:    16,930)    PLUNI T.DATIME.NANSEO 
930   FORMiT(*:»6AlC,52X2A10/*   EFFECTS   OF   TREATMENT    COMPARED  WITH  NATURA 
1L  CONDITIONS   (DECREASE   INDICATED  BY  -l*33XA10.*  SEO  YlELD*/*0*/ 
2   «  YEAR*/) 
Nl  =  I 
N2  =  I  +  54 

IF  l\2.GT. NYEARS)    N2    =   NYE ARS 

DO  15C  N   -  N1.N2 

IFINCOLIND  140,130 
130  WRIT?    (6,9201  YEARSIN) 

GO  TO  150 
140  Jl   =  NCOLINI 

HRITC  (6,920)   YEARSIN) , (SEDINC (N, J) ,JM,J1) 
150  CONTINUE 
160  CONTINUE 

c  ]F   THE   ANNUAL  TOTALS  HAVE   PRINTED,   GO  ON  TO  THE   PLOTS.      IF  NOT, 

C  SET   THE M  UP  AND  GO  BACK  TO  PRINT  THEM 

IF(IPASS)  170,210 
170   IPASS   =  0 

NAMSED    =   10H  ANNUAL 
C  COMPUTE   THE   ANNUAL  TOTALS 

N2   =  NYEARS 

Nl    =   NYEAR  S   -  1 

DO  2C0   I   =  2 , NYE  ARS 

IFINCOLIND)  180,70 
180  Jl   =  NCOLINI) 

IFINCOLIND. E0.NCOLIN2)  I  GO  TO  185 

J2  ■  Ji  ♦  1 

SEDNATIN2, J2I   =  SEONATIN2.J2)  -  SEDNAT I Nl, Jl ) 

SEDINC(N2,J2)   -  SE0INCIN2.J2I  -  SEDINC INI , Jl I 
185  DO  190  J  =  l.Jl 

SEDNAT(N2,J)    =   SEDNAT ( N2 , J)   -  SEDNATIN1.J) 
190  SEDINCIN2.JI   =  SE0INCIN2.J)  -  SEDINCINl.JI 

N2  =  Nl 

141  «  Nl  -  1 
200  CONTINUE 

GO  TO  70 

C  PLOT   THE   ANNUAL  INCREASES 

210  WRITE    16,9301   PLUNI T ,OAT I  ME , NAMSEO 

WRITE  16,940) 

940  F0RM»TI*0»35X*INCREASE*/*  YEAR  0*12(10H  ♦)) 

DO  260  I  -  1 , NYE ARS 

00  220  J  =  2,121 
220  POINT(J)   =  1H 

POINT(l)  =  1H. 

Jl  =  NCOLI I ) 

IFIJ1  -   I )  250,230,230 
230  DO  240  J  =  l.Jl 

K  ■   I SEDINC 1 1 , J )*0. 1 )   ♦  1.5 

IFIK.GE.1.AND.K.LE.121)   POINTIK)   -  CODE! J) 
240  CONTINUE 

C  PRINT  THE   LINE  OF  PLOT 

250  WRITE   16,950)   YEARS  1 1 ) , POINT 
950  FORMATI 1XI4.1X121A1) 
260  CONTINUE 
C  RETURN  TO  THE  MAIN  OVERLAY 

ENO 


Program  OLDNEW 


OVERLAY  (0LAYS,3,0) 
PROGRAM  OLDNEW 

C  COPY  -SAVOLD-  TO  -SAVNEW- 

COMMON  DAT | ME  12) .DECMAL .NRMANG, NS AVED, NY  EARS • PLNOPT I  19 ) , PLUN I T I  6 1 ■ 
1  REC0VR,REGI0N(8),REG0PT(5),SAVE,SEDRN2.WEIGHT 
INTEGER  OAT  I  ME, PLNOPT, PLUNI T.RECOVR.REGI ON, REGOPT, SAVE, SEDRN2 
DIMENSION  BL0CKI1889) ,1019] 
CALL   CORE  l-ll 

C  WHEN  AN  END  OF  FILE  IS  SENSEO  ON  AN  ID  READ,  COPYING  IS  COMPLETE 

REWIND  14 
10  CALL  GETREC   1 14 , 1 0 , 9 , 1  END  I 

IFIIENO)  60,20 
20  CALL  PUTREC  115,10,91 

C  COPY  ALL  YEARS 

30  CALL  GETREC    114, BLOCK, 1889, IEND I 

IF! I  END )  50,40 
40  CALL    PUTREC    115, BLOCK, 1 889 ) 

GO  TO  30 
50  END  FILE  15 

GO  TO  10 
60  CONTINUE 

CALL  CORE  (0) 
C  RETURN   TO  THE   MAIN  OVERLAY 

END 


Program  COMPLN 


OVERLAY  (OLAYS.4,0) 
PROGRAM  COMPLN 

C  COMBINE   THE   MANAGEMENT   PLANS   INTO  ONE  PRINTOUT   FOR   A  PLANNING  UNIT 

C   ANO   ADD   THE    DATA   TO   THE   REGIONAL  FILE 

COMMON  DAT  I  ME ( 2  I .DECMAL  .NRMANG.N SAVED. NY EARS. PLNOPT ( 1 9 ) . PLUN IT ( 6  I , 
1  RECOVR.R6GIONI8I .REG0PTI5I , S AVE .SE0RN2 , WE IGHT 

INTEGER   DAT  I  ME, PLNOPT, PLUN I T.RECOVR.REGI ON, REGOPT. SAVE. SE0RN2 

COMMON/P/MAME (2.15)  .NCOLI 165 )  »NPL AN . NUM I  12) , NVAR, OUT  I 165. 12) . 
1    VAR I  15) .YEAR (165) 

INTEGER  YEAR 

DIMENSION  LCOPYI 14) 

INTFGER  DATE  S ( 24 ) 

DATA  NAMED, 1>,NAMEI2,1)/10H  GENERA , 1 OHTED  RUNOFF/ 
DATA  NAME  I  1 , 2 > .NAME ( 2, 2  I /10H  PRE . 1 OHC I  PI  TAT  I  ON/ 

DATA  NAME  (1.3)  .NAME  (2.3W10H  E  V  APOTR  A ,  I  OHNSPI  RAT  I  ON/ 
OATA  NAME  1 1 ,4) ,NAM£ (2 ,4 1/1CHCHANGE  IN  .10HRECH.  RED./ 
DATA  NAME  I  1 ,5 ) .NAME  I  2.5 I/10H  CHANGE  IN.IOH  PACK  W.E./ 
DATA  NAMEI1,6),NAME(2,6)/10H  APR  16-.10H30  GEN  R  0/ 
DATA   NAME ( 1,7) .NAME (2 .7I/10H  MAY   1-.ICH15   GEN  R  0/ 

OATA  NAME  1 1 .8)  .NAME (2 ,8 ) /10H  MAY  16-.10H30  GEN  R  0/ 
DATA   NAME (1.9). NAME (2.9)/ 10H        JUNE    1-.10H15   GEN  R  □/ 


JUNE  16-.10H30  GEN  R  0/ 
JULY  1-.10H15  GEN  R  0/ 
, l'H  PEAK 
DATE  0.10HF  PEAK 
PFAK.10H 
PEAK.10H 


£/ 
6/ 

-DAY  R  0/ 
-DAY   P  0/ 


DATA  NAME!  1,1 :)  .NAME(2.10)/10H 
DATA  NAME (1 ,11) .NAME  12,11 1/10H 
DATA  NAME! 1.121 .NAME  12. 12I/10H 
DATA  NAME  I  1 , 13  I .NAME (2.13)/ 10H 
DATA  NAME! 1. 14)., NAME12. 141/1  OH 
DATA  NAME! 1 ,15)  , NAME (2 , 1 5 ) / 1 OHD ATE , 
CALL  CORE  (-1) 

C  COPY  T"E  MANAGEMENT  STRATEGY  DESCRIPTION 

REWIND  18 

IFIPLN0PTI5) .E0.0.AND.PLNOPTI6) .E0.0.AND.PLNflPT(7) .£0.0. AND. 
1  PLN0PTI8I .E0.0.AND.PLNOPTI9) .EQ.C I   GO  TO  9 
GO  TO  6 
3  WRITC    (6,900)  LCOPY 
900  FORMATI 13A10.A6) 
6  REAC   118,900)  LCOPY 

[F I  EOF ( 1 8 1  I  9,3 
9  CONTINUE 

C  PRINT    THE    INDICATED  VARIABLES 

DO  ISC  NVAR  =■  1,15 

IFINV»R.GT.5.AND.PLNOPTINVAR»4).EO.0l    GO  TO  180 
REWIND  12 

C  READ  THE  FIRST  RECORD 

RCAD    112,910)    NUMI1) ,YEARI II ,VAR 
910  FORMATI 12,13, 3X15F6. 2) 
OUTI 1,11    =   VAR I NVAR ) 
NC0LI1)    =  1 
NPLAN   *  I 

C  FILL   THE   FIRST  COLUMN 

DO  3C   I   =  2 , NYEAR S 

READ   112,910)  MPLAN.IYEAR.VAR 

C  IF  THIS  IS  STILL  THE  SAME  PLAN,  STORE  THE  INFORMATION 

10   IFIMPLAN  -   NUM 1 1 ) )  30,20 
20  YE  AR 1 1 1   »  I  YEAR 

OUTI I, NPLAN)    »   VAR I NVAR ) 
NCOLIII   *  1 
30  CONTINUE 

C  A  MAXIMUM  OF  -NYEARS-  YEARS  MAY  BE  SUMMARIZED 

READ   112,910)   MPL AN, I  YEAR, VAR 
IFIE0FI12I)  150.40 
40   IFIMPLAN  -  NUMIDI  80.50 
50  WRITE   (6,920)  NYEARS 
920  FORMAT  I *0A  MAXIMUM  0F*I4,*  YEARS  MAY  BE  SUMMARIZED  -  THE  BALANCE  A 
IRE  IGNORED*) 
60  READ   112,9101   MP LAN. I  YEAR. VAR 

IFIE0FI12))  150.70 
70  IFIMPLAN  -  NUM I NPLAN ) )  80.60 

C  FILL   THE  NEXT  CULUMN  I  UP  TO  1ZI 

80  I F I N PLAN  -  12)  100,90.90 
90  WRITE  (6,9301 

930  FORM AT  I *0A  MAXIMUM  OF  12  PLANS  MAY  BE  SUMMARIZED  -  THE  BALANCE  AXE 
1  IGNORED*) 
GO  TO  150 
100  NPLAN   =   NPLAN  ♦  1 
NUMI NPLAN )   =■  MPLAN 

C  FIND  THE  FIRST  YEAR  AND  STORE  IT 

00  110  N  -  1, NYEARS 
I F 1 1  YE AR  -  YEAR  IN ) )  110.120 
110  CONTINUE 

WRITE   16,940)  MPLAN, I  YEAR 
940  FORMATI *OMANAGE ME NT  PLAN*I4,*  STARTS  WITH  YEAR*I4,«  WHICH  HAS  NOT 
1PART  OF  THE  ORIGINAL  TIME  SPAN  -  JOB  ABORTED*! 
CALL  ABORT 
120  OUTIN, NPLAN)    =   VAR I NVAR ) 
NCOLINI    =  NCOLIN)   »  1 

C  FILL  THE  REMAINDER  OF  THE  COLUMN 

N   =  N  ♦  1 

IFIN  -  NYEARS)  130.130.60 
130  DO  140  I   =  N, NYEARS 

READ   112,910)  MPLAN.IYEAR.VAR 

OUTI I. NPLAN)   ■  VAR I NVAR ) 

NCOLI I  I  =  NCOLI I )  ♦  1 
140  CONTINUE 
C  GO  BACK  TO  READ  THE  NEXT  PLAN 

GO  TO  60 

C  WRITE  THE  INFORMATION  ON  THE  REGIONAL  FILE 

150  IFIN VAR. GT. 5)  GO  TO  156 

DO  155  I   *  1. NYEARS 
N  '  NCOLIII 

WRITE   1  13,945)   YEAR  I  I  ) .DECMAL . OUTI I » 1 1 .OUTI I , N ) . WE  I GHT .NV AR 
945  FORMATI I3,F3.2,3F10.5,I1) 

155  CONTINUE 

C  PRINT  THE  ARRAYS  IF  SPECIFIED 

156  1FIPLN0PTINVAR»4).E0.0)  GO  TO  180 
IF(PLN0PTINVAR*4).EQ.2I  GO  TO  175 
DO  17C  I   =  1, NYEARS, 55 

WRITE    16,9501   PLUNI T .OATI ME . NAME  1 1 .NVAR) , NAME  I  2, NVAR I 
950  FORMAT  I • 1*6A l 52 X2A1 0/11 3X2 A10) 

WRITE    16,9601    I NUM I N ) «  Nal , NPLAN) 
960  F ORM  AT  I *0       PLAN  NUMBER*! 5 ,11110) 

WRITE  16,970) 
970  FORMATI*  YEAR*/) 

Nl   =  I 

N2  =   I   ♦  54 

IFIN2.GT. NYEARS)    N2   =  NYEARS 
IFINVAR.E0.13.0R.NVAR.E0.15)   GO  TO  165 
00    160   N    =  N1.N2 
Jl    "  NCOLIN) 

WRIT?   16.9801   YEARINI , IOUTIN, J) , J*l,  Jl  I 
980  FORMATI 1X15, 5X12F10. 21 
160  CONTINUE 

GO  TO  170 

C  CONVERT  THE  DATES  FROM  THE  P SEUDO- JUL  I  AN  FORMAT 

165  DO    167  N   =  N1.N2 
Jl    =  NCOLINI 


J2  *  1 
DO  166 
K   =  OUT  IN, J) 

CALL  GOATE    I K ,0 ATE S I J2 ) I 


.  Jl 


J2 


J2 


166  CONTINur 

J2  =  J2  -  1 

WRITE   (6,990)   YEARINI, I0ATESIJ),J-I.J2I 
990  FORMATI 1X15, 5X12(5X12, */«I2l) 

167  CONTINUE 
170  CONTINUE 

IF  INVAR .LE .5. AND. PLNOPT INVAR«4) .EO. 1 1    GO   TO  1R0 
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c  COMPUTE    1HE    DIFFERENCES   BETWEEN   THE   NATURAL    ANO   TREATED  CONDITIONS 

175  CALL  DIFFER 

iso  continue 

C ALL   COSE  ICI 

C  RCTU=N    TO    THE    PRIMARY  OVERLAY 

END 


Subroutine  DIFFER 


SUBROUTINE  DIFFER 
C  COMPUTE    ANO   PRINT    THE    DIFFERENCES  CAUSED   BY    THE  TREATMENTS 

COMMON  OAT  I  ME  121 tDECMAL ,  NRMANG , NSAVED , NYE ARS  ,  PLNOPT 1191, PLUN ITI 6  I. 
1  RECOVR . REGION! 8) tREGOPT 1 5  I , S AVE . S EDRN2 , WE  I GHT 

INTEGER  DATI ME, PLNOPT, PLUNIT, RECOVR, REGI ON, REGOPT,SAVC,SEDRN2 

COMMON /P/NAME  12  .15)  .NC0LC65I  «NPL AN  » NUN (  12  I  ,  NV  AR  ,  OUT  I  165.  12). 
1    VAR I  151 .YEA" (1651 

INTEGER  YEAR 

DIMENSION  I0UTI12I 

INTEGER  000(61 

DATA  0D0/62.154,155,21T,279,372/ 
DO  110   I    "   1 .NYE ARS .55 

WRITE    16.910)    PLUNIT.DATIME.NAME(l.NVAR) .NAME ( 2 . NVAR I 
910  FORMAT(*1*6A10,52X2A10/*  EFFECTS  OF  TREATMENT  COMPARED  WITH  NATURA 
1L  CONOITIONS   (DECREASE   INDICATED  BY  -l*33X2A10l 

WRITE    (6.92CI  (NUMINI.NM.NPLANI 
920  FORMAT ( *0       PLAN  NUMBER*! 5 . 1 1 1 10  I 

WRITE  16.930) 
930   FORMAT ( •   YEAR*/ ) 

Nl    »  I 

N2  -   I  ♦  5* 

IFIN2.GT.NYEARS)    N2    ■  NYEARS 
00  100  N  =  NI.N2 
Jl  ■  NCOLIN) 
IFIJ1  -  1)  20.10 

C  NO  TREATMENT 

10  WRITE    (6.940)  YEAR(N) 
9*0  FORMAT! 1X15, 15X11F10. 2) 
GO   TO  IOC 

C  GET   THE  DIFFERENCES 

20   IFINVAR.E0.13.0R.NVAR.EQ.15)   GO  TO  40 

00  30  J  3  2.J1 
30  OUT(N.J)    =  OUTIN.J]    -  OUTIN.ll 

WRITE   (6.940)   YEARINI , I  OUT ( N , J ) , J-2 , Jl ) 
GO  TO  100 

C  DATES 

tO  II  '  OUTIN.ll 
DO  90  J  ■  2.J1 
12  ■  OUTIN.J) 
IOUT(J)  =12-11 

C  CHECK  FOR  000  DAYS  BETWEEN  THEM 

IF(IOUTUI)  50.90.70 

C  li  |  s  LARGER 

50  DO  60  K  ■  1.6 

IF( I2.LE.0DDIKI .AND.ODD(K) .LE.Il )   IOUTIJI  =   IOUTIJ)  »  1 
60  CONTINUE 
GO  TO  90 

c  12  is  LARGER 

70  00  80  K  ■  lt6 

IF(  I  l.LE.OOD(K)  .AND.OOO(K)  .LE.I2)    IOUTIJI   -   IOUTIJ)   -  1 
80  CONTINUE 
90  OUTIN.J)   =  IOUTIJ) 

WRITE   16,950)   YEAR  IN) . I I0UT(J)»J*2.J1) 
950  FORM  ATI  1X15,15X11110) 
100  CONTINUE 
110  CONTINUE 

C  PLOT  THE  DIFFERENCES 

WRITE   16,910)   PLUNIT. OAT  I  ME . NAME ( I . NVAR) .NAMEI2. NVAR) 
IFINVAR.E0.13.0R.NVAR.es. 15)  GO  TO  120 
WRITE  (6,9601 
960  FORMAT (*0*35X«DECREASE»52X« INCREASE*) 
CALL   PLOTD  (10.0) 
RETURN 
120  WRITE  16,970) 

970  F0RMAT(*0*36X*EARLIER*52X*LATER«) 
CALL   PLOTD  (1.01 
RETURN 
END 


Subroutine  PLOTD 


SUBROUTINE   PLOTD   I  SCALE ) 
c  °LOT  THE  DIFFERENCES 

COMMON  DAT  I  ME (2) .DECMAL .NRMANG. NSAVED. NY EARS. PLNOPTI 19) . PL UN  I T I  6 ) . 
1  RECOVR.REGIONI 8) .REGOPTI 5 ) , SAVE , SEDRN2 , WE IGHT 

INTEGFR  0 ATI  ME, PLNOPT. PLUNIT, RECOVR, REGI ON, REGOPT.S AVE, SE0RN2 

COMMON /P /NAME  12,15) .NC0LI165I ,NPLAN,NUM( 12  I , NV AR , OUT  I  165. 12), 
1   VARI15I .YEAR  11651 

INTEGER  YEAR 

INTEGER  COOE(ll) .P0INTI121I 

DATA   C0DE/1H1 ,IH2,1H3, 1H4 , 1 H5 , 1H6 , 1H7 , 1 H3 . 1H9, 1HA,  IHB/ 
WRITE  (6,910) 

910  FORMAT!*  YEAR  *,6(10H-  >,1H0,6I10H  *>> 

DO  S5   I   =  1 , NYEARS 

DO  10  J  =  1,121 
10  POINT(J)   =  1H 

P0I~iT[61l    =  1H. 

Jl    =■  NCOLI 1  I 

IFIJ1   -    II  20,40 

C  SCALE  AND  TRANSLATE   THE  DIFFERENCES,   THEN  STORE  THE  CODE 

20  DO   3  0  J   *  2.J1 

K   ■=    (OUT ( I . J ) *SC ALE )   ♦  61.5 

IFIK.GE.1.AND.K.LE.121)   POINTIKI   =  COOE(J-l) 
30  CONT INU5 

C  WRITE  THE  LINF 

40  WRITE    16.9201   YEARI I ) .POINT 
920  F0R"1TCXI5,121A1> 
50  CONTINUE 
END 


Program  COMRGN 

OVERLAY  (OLAYS.5,0) 
PROGRAM  COMRGN 

C  COMBINE   THE  PLANNING  UNITS   INTO   A  REGION 

COMMON  0ATIMEI2) .OECNAL , NRMANG , NSA VED, NYEARS ,PLNOP T 1 1 9 ) , PLUNI T 16 ) . 

1  RECOVR, REGION! 8 I.REGOPT  (5 ) ,  SAVE  .SEORN 2*  WEIGHT 

INTEGER  Dotihe . PLNOPT , PLUNIT  .RECOVR, REGI CN , REGOP T, SA VE , SEDRN2 
DIMENSION  OUT!  165,10) ,WT (51 
INTEGER  YEARI165I 
DIMENSION  NAME(2,5> 

DATA  NAME  I  1,1)  .NAME (2,1 ) /10H  GENERA , 10HTEO  RUkOFF/ 
DATA  MAMEI1.2) , NAME (2. 2 ) /10H  PRE • 10HC IPITA TI ON/ 

DATA  NAHEIl.JI .NAME (2,31 /10H     E VAPOTRA , 10HNSPIRATI ON/ 
DATA   NAMEIl, 41  .NAME  12.4) /10HCHAKGE    IN    .10HRECH.  REQ./ 
DATA   NAME (1,51  .NAME  (2, 5 )/10H   CHANGE    IN.IOH   PACK  W.E./ 
CALL  CORE  l-H 
BEHIND  13 

DO  5  I  =  1. NYEARS 
5  RE AO  (13.910)    YEAR ( II 
REWIND  13 
DO  10  I  «  1.5 
10  WTII)  »  0.0 
DO  20  J  *  1,10 
00  20  I  -  1,165 
20  OUTII.J)   =  0.0 

C  READ  THE  FIRST   RECORD  OF  A  VARIABLE  FOR  A  PLANNING  UNIT 

30  REAO  (13,910)   IYEAR.UNALT, ALT, WEIGHT, NVAR 
910   FORMAT  113, 3X3F10. 5, III 
IFIE0FU3M  60, 40 

C  ACCUMULATE  THE  WEIGHT 

40   WT (NVAR)   *  MT(NVAR)   I  WEIGHT 
IF(IYEAR.NE.YEARIl) I  GO  TO  150 

C  ACCUMULATE  THE  WEIGHTED  VALUES 

NVAR5  =   NVAR  »  5 

OUTll.NVAR)   a    OUT(l.NVAR)    «    IUNALT   •  HEIGHT) 
OUTIl.NVARSI  =  0UTII.NVAR5)   *  (ALT  •  WEIGHT) 
00  50   I  =  2, NYE ARS 
REAO  (13,9101   I  YEAR, UN ALT, ALT 
IFIIYEAR.NE.YEAR(D)  GO  TO  150 

OUTll.NVAR)    =    OUTll.NVAR)    «    (UNALT    •  HEIGHT) 
0UT1I.NVAR5)   «   0UT(I,NVAR5>   «   I  ALT  •  HEIGHT) 
50  CONTINUE 
CO  TO  30 

C  PRINT  EACH  VARIABLE  AS  NEEDED 

60  00  140  NVAR  *  1,5 

IFIREGOPT(NVAR) .EQ.OI  GO  TO  140 
IF  (  HT  (NV  AR)  )  70,14)0 
70   WRITE    (6,920)    REGION  ,  DAT  IME  ,  '•APE  II ,  NVAR  )  .NAME  1  2,  NVAR  I 
920    FORNAT(*1*8AIO,32X2A10/"    REGIOAAL  SUHHARY*96X2A10) 
N VAR5  •  NVAR  »  5 

IF  I NT INVAR). GE. 0.99. AND. WTINVARI.LE. 1.01)  GO  TO  78 
WRITE   16,930)   HT (NVAR) 

930  FORMAT  t  *  0  -NOTE   THE  COMBINED  HEIGHTS  OF  THE  PLAMN 

1ING  UNITS  K*rs.2,«  AS  OPPOSEO  TO  THE  NORNAL  1.0  -  -    NOTE- 

2   -*/25X*THEREF0RE,   ALL  VALUES  BEL ON  ARE  ADJUSTED  RESULTS,  MAOE 

3  TO  CORRESPOND  TO  THE  NORN*) 
DO  74  I  =  1, NYEARS 

OUTll.NVAR)  *   OUT ( I .NVAR I /HT (NVAR) 
74  0UTII.NVAR5I  ■  OUT  I I.NVAR5) /NT (NVAR) 
70  WRITE  (6.9401 
940  FORNAT(*0*3(6X*YEAR      NATURAL  MANAGEOMOX)/) 
DO  130  I  *  1.55 
IF(I  -  NYEARS)  00.80,140 
SO  J  =  I  ♦  55 

IF(J  -  NYEARS)  100,100,90 
90  WRITE  (6,9501    YEAR ( I) , OUT (I, NVAR) , OUT ( I.NVAR5) 
950   FORMAT ( 1X3(110, 2F10. 2, 10X1 > 

GO  TO  130 
100  K  *  J  *  55 

IF(K  -  NYEARS)  120,120,110 
110  WRITE  (6,950)  YEAR(I),0UT(I,NVAR),0UT(I,NVAR5),YEAR(J), 
1  0UT(J,NVAR),0UT(J,NVAR5) 
GO  TO  130 

120  WRITE  (6,950)    YEAR (I) .OUT (I, NVAR) .OUT  1 1 .NVAR5I ,YE»R( J) • 

1  0UT(J.NVAR),0UT(J.NVAR5),YEAR(K),0UT(K,NVAR),0UT(K,NVAR5) 
130  CONTINUE 
140  CONTINUE 
GO  TO  160 

C  THE  YEARS  ON  THE  VARIOUS  UNITS  00  NOT  HATCH 

150  WRITE  (6,960) 

960  FORMAT (• OTHE  YEARS  PROCESSED  ON  THE  VARIOUS  UNITS  HERE  NOT  CONSIST 

IE  NT ,  SO  THE  REGIONAL  SUMMARY  IS  BEING  OHITTEO*! 
160  CALL  CORE  (0) 

C  RETURN  TO  THE  PRIMARY  OVERLAY 

END 


Program  LSTSAV 


OVERLAY  IOLAYS.6,0) 
PROGRAM  LSTSAV 

C  LIST   THE  FILES  ON  -SAVNEW- 

COHMON   OAT IME 12) .OECMAL. NRMANG, NSAVED. NY  6 ARS. PLNOPTI 19 ) . PLUNIT I  6 ) . 
1  RFCr)VR,REGION!8)  .REGOPTI5)  ,  SAVE  ,  S  EDRN2  .  WE  IGHT 
INTEGER  PST1 HE .PLNOPT, PLUNI T, RECOVR, REGI ON, REGOPT, SAVE, SEDRN2 
DIMENSION   PLOCKI 1889) ,10(9) 
CALL   CORE  1-1) 
END  FILE  15 
PcWINO  15 

WRITE   14,9101   DAT  I  ME 
910  F0RMATI«1LISTING  OF   FILES   ON  -SAVNEW-   AS   OF  *2A10/ 

1  *j*6X*FILE         NUMBER  FIRST  LAST*/ 

2  5X    «NUMBER  YEARS  YEAR  YE AR* 10 X*PL ANN  I NG  UNIT  !D*I 
IFILF   -  C 

C  GET   AN   ID  RECORD 

10  CALL    GETRFC  I15,1D,9,IENPI 
IFIICND)  50,20 

C  GET    THE    FIRST   YEAR,    THEN   THE  LAST 

20  IFILE   >   IFILE   ♦  1 

CALL  0FTR5C   1 15 , BLOCK,  1989,  1  END ) 
FIRST  =  BLOCKI1I 
30  PLAST  =  BLOCK  I  1 ) 
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CALL  GETREC   ( 15 . BLOCK, 1889, I ENO I 
IFII5ND)  AO, 30 
AC  WR  1  T  L    (6,  <J20  1  IF1LE»I0I7)»F1RST.DLAST.!ID(I),I»1»6I 
920  FORKaT(«3«2I 10.2F10.2.10X6AIO) 
GO  TO  10 
50  CONTINUE 

O  RETURN    TO   THE    PRIMARY  OVERLAY 

END 


Program  PROOF 


OVERLAY  (0LAYS,7,01 
PROGRAM  PROOF 

C-  PROOFR  E  AO    THE    PARAMETER  DECK 

COMMON  OAT  I  ME  12) .OECMAL . NRMANG, NSAVEO, NYOARS , PLNOPT ( 19 ) ,PLUN IT ( 6 ) , 
1  RECOVR.REGIONI 8) .REG0PTI5) , S AVE , SE0RN2 , HE IGHT 
INTEGER  DATIME»PLNOPT,PLUNIT,RECOVR»REGI ON , REGOPT , S AVE, S EDRN2 
COMMON/S/AVSOILdll  .DECLINdl  I  .NROADS , RATNRM ( 1 1 1 , ROADM 1  (  1 1 ) , 
1   POADWI 11 ) ,TANCUT( HI ,TANFIL( 111 » T ANRHO ( 11  I , YRCN ST ( 1 1 1 
INTEGER  YOCNST 

OIMENSION  CARD ( 5  I .DATCRO ( 8 1 , 1  DA TE S 1 6 1 , P AR AM ( 9 ) 
CALL  CORE  (-11 

C  READ  THE  REGION  CAROS 

READ  15,9101  NAME, N  YE  AR  S,  SEDRN2  . SAVE, R6C0VR, REGOPT, REGION 
910  F0RHAT(A6,4X4I5,5I1/8A10) 

IF (NAME ■ EO* 6HREGI ON)  GO  TO  10 
WRITE  16,920) 

920  FORMAT(*0THE  FIRST   INPUT  CARD  IS  NOT  THE  REGION  CARD*) 
CALL  PRABRT 

10  IFINYEARS.GT.0.AND.NYEARS.LE.165)  GO  TO  20 
WRITE   (6,930)  NYEARS 
930  FORMAT ( ♦ OTHE  NUMBER  OF   YEARS   1*13,*)   IS  NOT   BETWEEN   1   AND  165*1 
CALL  PRABRT 

C  READ  A  PLANNING  UNIT  CARD 

20  READ   (5,940)    PLUNIT, DECMAL, INFILE, WEIGHT, ( PLNOPT ( I  I, 1-1,  101, 
1  PLN0PT(16I,PLN0PT(18) 
940  F0RMAT(6A10,F2.2,1XI2,F3.2,12I1> 
IF(E0F(5>>  120,30 

C  IF  THIS  IS  A  RECOVERY  DECK ,  COPY  IT  TO  THE  REGION  FILE 

30  IFIPLUNITI 1 1 .NE.10HREC0VERY  D)  GO  TO  50 
AO  READ   (5,9501  CARD 
950  F0RMAT(2A10,A6,F10.5,A1) 

IF(CARD(1I.EQ.10HEND  OF  REC )  GO  TO  20 

C  IF  A  NEW  WEIGHT  WAS  SPECIFIED,  REPLACE  THE  ONE  ON  THE  CARD 

IFIWEIGHT.GT.O.OI  CAROIA)   -  WEIGHT 
WRITE   113,950)  CARD 
GO  TO  AO 

C  IF  THIS  IS  A  DATA  DECK ,  COPY  IT  TO  THE  UNEDITED  DATA  FILE 

50  IF  I PLUNI T ( 1 ) .NE . 10HDATA  DECK  )  GO  TO  58 
$2  READ  (5,955)  OATCRO 
955  FORMAT! 8A10) 

IF(OATCRD(1).E0.10HENO  OF  DAT)   GO  TO  5A 
WRITE   (10,955)  DATCRO 
GO  TO  52 
5A  END  FILE  10 
GO  TO  20 

C  DEFINE  THE  REMAINING  OPTIONS 

58  PLNOPT(ll)   -  PLNOPT(IO) 

PLNOPT!  12)  =■  PLNOPT(IO) 

PLNOPT!  13)   ■»  PLN0PTI10I 

PLN0PTI1AI  »  PLN0PT110I 

PLNOPT! 15)   "  PLNOPT(IO) 

PLNOPT! 17)   *  PLNOPT 1 16  I 

PLN0PTI19I   =  PLNOPT 118) 
C  WRITE  THE  RECORD 

WRITF   (191   PLUNIT, DECMAL, INFILE. WEIGHT, PLNOPT 

LAST1  »  0 

C  IF  THE   INPUT  UNIT  IS  1A,  THE  NORMAL  SIMULATION  WILL  NOT  BE 

C   PERFORMEO.     BUT  IF  IT  IS  NOT  1A,  READ  THE  STATION  PARAMETERS 

IFIINF1LE  -  1A)  60,80 
60  CALL   P ARAMS 

C  READ  THE  SPECIFIED  CONDITIONS  CAROS 

70  READ   (  5,960)  NAME .PEAKWE , I  DATES 
960  FORMAT ( A10.10XF5. 2.6X31 2,1X312) 
WRITE   119)   NAME , PEAKWE , I  DATES 
IFINAME.E0.10HSPECIFIED  )  GO  TO  70 
IFINAME.E0.10HEN0  OF  NAT)  GO  TO  80 
WRITE    (6,970)   NAME, PLUNIT 
970  FORMAT ( *0A  SPECIFIED  CONDITIONS  CARD  WAS  EXPECTED  UNDER  PLANNING  U 
1NIT  *6A10/*     BUT  COL  1-10  OF  THE  CARD  RE  AO  CONTAIN  *A10) 
CALL  PRABRT 

C  READ  THE   MANAGEMENT   STRATEGY  DECK 

80  READ   (5,980)   NAME, NUM. NEXTYR , PAR AM, SPECCO 
980  F0RMATIA10, 10X215, 10F5.0) 

WRITE   (19)   NAME, NUM. NEXTYR, PARAM.SPECCD 

IFINAME.NE.10HMANAGEMENT. AND. NAME. N6.10HROAD  CONST  I  GO  TO  110 
IFILAST1  -  NEXTYRI  90.80,100 
90  L  AST  1    =  NEXTYR 
GO  TO  80 
100  WRITE    (6,985)  PLUNIT 

985  FORMAT ( *00N  PLANNING  UNIT  *6A10/«     THE   MANAGEMENT  PLAN  CAROS   ARE  N 
10T   IN  ORDER  BY  YEAR* ) 
CALL  PRABRT 
110   IF1NAME.EQ.1CHEND  OF  STR I   GO  TO  20 

WRITE   (6,9901  NAME 
990  F0PMAT(«3A  MANAGEMENT  PLAN  OR  ROAD  CONSTRUCTION  CARD  WAS  EXPECTED 
1UN0EC   PLANNING  UNI T »/2 X6A1 0/ •     BUT  COL   1-10   OF  THE  CARD  READ  CONTA 
2IN  *A10) 
CALL  PRABRT 

C  PROOFREADING  COMPLETE 

120  ENO  FILE  19 
REWIND  19 
NSAVEO   =  C 

C  GET   THE  DATE   AND   TIME   OF   THIS  RUN 

CALL  DATE  (DATIMEHII 
CALL  TIME  (DATIMEI2II 
CALL   CORE  (0) 

C  RETUfN    in    THE    MAIN  OVERLAY 

END 


Subroutine  GETFMT 


SUBROUTINE  GETFMT 

C  GET   THE  FORMAT-INDICES  CARO  AND  CHECK  FOR  ERRORS 

INTEGER   VARFMT ( 7  I 
I  ERR   =  j 

C  READ    THE  CARD 

RE  AO    (5.91C)    NAME, VARFMT, NFILE, 1M, 10, IY,  IMX, IMN, IP 
910   FOR'MT  (  A6,  6A10,  A4,  IX  12  ,  1X61  1  ) 
IFINAME.E0.6HF0RMAT)  GO  TO  10 
WRITE    I6.92C)  NAME 
920  FORMAT !*0T1(E  VARIABLE  FORMAT  CARO  WAS  EXPECTED.   BUT  COL   1-6  OF  THE 
1    CARD  READ   CONTA I N   *A6 I 
CALL  PRABRT 

C  CERTIFY  THE   VALIDITY  OF   THE   INOICES   -  START  WITH  THE  MONTH 

1C  NAME    =    1CHM0NTH  75 

IF! IM.GT.0.AND.IM.LT.7]   GO  TO  20 
WRIT!!    (6.93C)    NAME  .  I M 
930  FCRKATI1XA10.I6.*  FORMAT  CARD,    INVALID   INDEX  -  MUST   BE  1  TO  6   IN  I 
INDICATED  COLUMN* I 
I  ERR   =  1 

C  OAY 

20  NAME    =    10HDAY  76 

IF! ID.GT.O.ANO. ID.LT.7I   GO  TO  30 
WRITE   (6,9301   NAME, ID 
I  ERR  =  1 
GO  TO  50 
30  IF( IO.NE.IMI   GO  TO  50 
WRITE   (6,9501   NAME. ID 
950  FORMATI 1XA10.I6,*  FORMAT  CARD.   THIS   INDEX  HAS   BEEN  USED  PREVIOUSLY 
1*  I 
I  ERR  =  1 

C  YEAR 

50  NAME    "    10HYEAR  77 

IF( IY. GT.C.ANO.IY.LT. 71   GO  TO  60 
WRITE   (6,9301   NAME , I Y 
IERR   '  1 
GO  TO  80 

60   IF( I Y.NE.IM.AND.IY.NE. IDI   GO  TO  80 

WRITE   (6,953)  NAME , I Y 

IERR  =  1 

C  MAXIMUM  TEMPERATURE 

80  NAME   ■   10HMAX  TEH  78 

IF( IMX.GT.O.ANO. IMX.LT.7)   GO  TO  90 

WRITE    (6.9301    NAME . I  MX 

IERR  =  1 

GO  TO  110 

90  IFIIMX.NE.IM.AND.IMX.NE.ID.AND.IMX.NE.lv)  GO  TO  110 
WRITE   (6.950)   NAME . I  MX 
IERR  =  1 

C  MINIMUM  TEMPERATURE 

110  NAME   =   1  OHM IN  TE M  79 

IFIIMN.GT.O. AND.IMN.LT. 7)  GO  TO  120 
WRITE   16,930)   NAME, IMN 
IERR   =■  1 
GO  TO  1A0 

120   I F ( I MN. NE • I M. AND. IMN.NE. ID. AND. IMN.NE.IY.AND.IMN.NE.IMX)   GO  TO  1A0 

WRITE   (6.950)   NAME. IMN 

IERR  -=  1 

C  PRECIP 

1A0  NAME   =   10HPRECIP  80 

IF! I P.GT .0. AND. I P.LT.7)  GO  TO  150 

WRITE   (6,930)  NAME , I P 

IERR  =  1 

GO  TO  170 

150    IF! IP.NF.IM.AND. IP.NE. ID.AND. IP.NE. IY.ANO.IP.NE. IMX.AN0.1P.NE. IMN) 

1  GO  TO  170 
WRITE   16.950)   NAME. IP 
IERR  =  1 

C  CHECK  FOR  ERRORS 

170   IF( IERR )  190.180 

180  WRITE   119)   VARFMT, NFILE, IM, ID, IY, IMX, IMN, IP 

RETURN 
190  CALL  PRABRT 

END 


Subroutine  GETPOT 


SUBROUTINE  GETPOT  ( LAT , ASPECT .SLOPE ) 

C  DEFINE   THE   POTENTIAL  R  ADI AT  I  ON  VALUES   AND  THE  SLOPE/ASPECT 

C   ADJUSTMENT  FACTORS    (THE  TABLES  ARE  FROM  -POTENTIAL   SOLAR  BEAM 

C   IRRADIATION  ON  SLOPES-  BY  FRANK  ANO  LEE,   1966.     ONLY  THOSE 

C   PORTIONS  OF   THE   TABLES  PERTAINING  TO  THE  CENTRAL  ROCKY  MOUNTAINS 

c   (LATITUOE   38  -  AA I    ARE   INCLUDED.     LIKEWISE,   UNMANAGEABLE  SLOPES 

t   (GREATER  THAN  AO  PERCENT)  WERE  ELIMINATED 

DIMENSION  LI192A) 

DIMENSION  PnTENT(2AI .SLPASP12A) 

INTEGER  ASPECT, SLOPE 
C*****LATI TUDE  38 
C  HORIZONTAL  SURFACE 

DATA   (L( I  I, 1-1,131/ 
1  102C, 100A,97A,930,872,802,722,6  39,558,485,A25,3  83,3  59/ 
C  N  ASPECT 

DATA   (L( I  I , I  =  1A,65) / 

1  1P22, 1000, 962. 907, 837, 754. 662, 569, A80.A02, 340, 297, 273, 

2  1013,  987,9A2,877,79A,700,597,A95,A01,319,257,21A,  190, 

3  996,  965, 913, 839, 746, 641, 530, 420, 322, 2A0, 178, 138, 115, 
A      971,    937, 879, 797, 695, 581, 461, 346, 2A6, 165, 107,    71,  53/ 

C  S  ASPECT 

DATA    (L (  I  I  ,  I =66,1171 / 

1  1011.  999,977,944,398,842,775,703,630,563,507,467,443, 

2  994,    986, 972, 949, 916, 873, R19, 758, 695, 634, 582. 545. 522. 

3  971,  167,960,947,925,895,854,805,751,697,650,614,593, 
A     9A2,    9A3.9A2, 938,927, 909, 880. 8A3, 798, 751, 708, 675, 655/ 

C  NNE   CR   NNW  ASPECT 

DATA   (LI  I  ),  1-118,169)/ 

1  1021,1000,963,909,839,757,667,575,487,409,347,304.280, 

2  1012.  987,943.879,799,707,608,508,415,335,272,229,205, 

3  99A,  965,915,8A3,75A,653,5A7,AA2,3A6,264,202,161,138, 
A     969,   937,881,802,705,598,496,377,281,200,141,102,  81/ 

C  SSE  OR   SSH  ASPECT 

DATA    (LIT). 1=170.221)/ 
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'.  101*1  (11, 1'7,«),  996,  839,  771  ,698  ,  625  ,5  57,  501  ,460.437, 
:     vit,   93*  ,973. 9*9,914  ,368,312,  749, 68*, 6?'.  571,  532,  539, 

3  17;.,     77;  ,  063,  949,  924.  990.  845.  792,  735.679,631  ,596  , '.74, 

4  1'  ',  >'.r  ,  747,  j4[  ,  927,903  ,  869,826,  778  ,728  ,684,651  ,631/ 
c  V     i;    N.  ASPECT 

DATA  (1(11,1-222,2731/ 

1  1  1"3C,  965|  9 13,  846,  768,6  8  0,590,50  4,4  28,  366,  3  24,2  99, 

2  ICi:,  7P-, 747, 899,815 ,73C ,636,541 ,452 . 374, 312, 269,245, 
1  901,  167,  723, 860, 781  ,690  ,592 ,494,403, 324,263,222,  198, 
4      969,    74? , 394, d2 7, 744 ,649,549,450, 359,281 , 222, 182, 159/ 

C  SE  3«  SW  ASPECT 

DATA  (LI  1  )  .  1  =274,3251/ 

1  1  -14,: TO;, 976, 94 -,891  ,83  0,760,684,609,540,483.442,418, 

2  10.3,  793,074,945,905,854,792,724,655,590,535,496,473, 

3  99C,     781,967, 946, 913, 871, 817, 757, 693, 633, 581, 544, 521, 

4  960,  965,9^6, )41 , 016,882 ,836, 783 ,728 ,669,621 ,585 , 563/ 
C  c%,z   r;o   KNH  IS'ECT 

OAT-    (1.(11,  1  =  326  .3771/ 

1  10 1 9, 1 1 , 968, 920, 857, 783, 700. 613, 529, 4 54, 394, 352, 327, 

2  ISM,  791,956,905,840,762,676,587,502,427,366,324,300, 

3  9>9T.    976, 94;,887, 819, 740, 652, 563, 478, 402,  342,  301,  277, 

4  07,1,  057,920,866,797,718,630,540,456,  381,322,  281,258/ 
C  ESO   0°  JSU  ASPECT 

DATA   (LIM, 1=378, 4291/ 

1  1016,1'. 01  ,97  5,93  5,8  82,817,743,664,586,515,457,415,  391, 

2  1008,  990,972,937,888,829,760,685,611,542,485,445,421, 

3  997,  986,066,935,891,837,773,703,632,566,511,471,448, 

4  983,  973,956,929,891,842,782,717,649,586,532,494,471/ 
c  E    OK    W  ASPECT 

flATA  (1(11,1=430,4811/ 

1  1C ; 9, 10C1, 07?, 928, 870, 801, 722, 639, 558, 4 85, 4 26, 384, 3 59, 

2  1311,  994,965,922,866,797,719,638,558,486,427,385,361, 

3  IOC    984,056,014,859,792,716,636,557,486,428,  387,363, 

4  936,  970,944,903,850,785,711,633,556,486,429,389,366/ 
C«»»«LAT1TUDE  40 

C  HORIZONTAL  SURFACE 

DATA    (L( I  I , 1=482,4941/ 
I   1022,1004,971,923,860,786,702,615,531,4  56,395,353,32  8/ 
C  N  ASPECT 

(7ATA    (L  I  I  >,  1=495,546)  / 

1  1021,  998,957,898,823,735,640,543,452,373,310,267,243, 

2  1010,  982,934,865,778,679,573,468,372,290,227,185,162, 

3  991,    958,903,825,728,619,503,391,292,210,150,111,  90, 

4  964,  928,967,780,674,556,433,316,216.137,  82,  48,  32/ 
C  S  ASPECT 

DATA  (1111,1=547,5981/ 

1  1015, 1001 ,977,940,890.829,757,681 ,605,536,478,437,413, 

2  1031.  992,975.948,911,863,804,739,672,608,555,515,492, 

3  980,  975,965,949,923,888,842,788,730,673,623,586,564, 

4  954,  953,953,942,927,904,871,828,779,729,683,648,627/ 
C  NNE   08   NNW  ASPECT 

DATA   (L 1 1 1  1 1 =599,650 ) / 

1  1021,  998,958,899,825,739,645,549,459,380,317,274,250, 

2  1010,  982,935,868,783,687,584,481,386,305,242,200,176, 

3  990,  959,905,829,736.631,521,414,317,235,174,134,112, 

4  963,  928.869,786,685,574,459,349,252,173,114,  78,  59/ 
C  SSE  08  SSW  ASPECT 

DATA    (LI  I  )  .  1=651  .702)/ 
I  10 16,1002 ,977,939,888,826,753,676,600,529,472,431,407, 
1   1003,  993,975,947,908,858,797,729,661,596,542,503,479, 

3  985,  979,968,949,921,882,832,775,714,655,604,567,545, 

4  961,  959,954,944,926,898,859,811,758,705,659,624,602/ 
C  NE  08  NW  ASPECT 

OATA   ((.(  1  1  ,  1=703,7541  / 

1  1020,  998,960,904,833,750,659,565,477,399,337,294,269, 

2  1009,  984,941,879,801,711,613,515,424,345,283,240,216, 

3  939,  962,915,848,764,669,568,468,375,296,235,194,171, 

4  964,  935.884,814,726,628.525,423,332,254,195,156,135/ 
C  SE  08  SW  ASPECT 

DATA   I  L  ( I  I  » I =755 ,806) / 

1  1017,1002,976,935,882,817,742,662,584,512,454,412,388, 

2  IOCS,  997,976,943,898,842,775,703,631,563,507,467,443, 

3  995,  987,971,945,909,861,803,738,671,608,554,515,492, 

4  978,  972,961,943.914,875,824,766,705,645,595,557,535/ 
C  ENE  OR  WNW  ASPECT 

DATA   (LI  1  I,  1  =  807,8581/ 

1  102 100  0,964,912,845,766,679,589,502.4  26,364,322,297, 

2  1011.  939,951,897,827,745,655,563,475,398,337,295,271, 

3  996,  973,934,878,806,723,631,538,451,375,314,273,249, 

4  977,  954,914,857,784,700,609,516,430,354,295,255,231/ 
C  E SE  OR  WSW  ASPECT 

DATA    (L I  I  I ,  1  =  959,9101 / 

1  1019,10  02,973,929,872,802,724,641,560,4  87,427,385,361, 

2  1012,  997,971,932,880,816,742,663,586,515,457,416,391, 

3  10C2,  989,967,932,884,826,757,683,609,540,483,443,419, 

4  989,  978,958,928,885,832,768,698,627,561,506,466,442/ 
C  E  OR  W  ASPECT 

DATA    (L I  1 ) , I =911  ,962  I  / 

1  102  j ,1001. 969, 921,859, 785, 702, 615, 532, 4 57, 396, 3 54, 329, 

2  1013,  995,963,916,855,782,700,615,532,458,398,356,332, 

3  1O02,  984,954,908,849,778,697,614,532,459,400,359,335, 

4  988,  072,942,898,841,772,694,612,532,460,402,361,338/ 
C*«*«»LAT1 TUOc  42 

C  HORIZONTAL  SURFACE 

OATA    IL I  I  ) , I =963,9751  / 
1  102 3, IOC  3, 96 7, 9 15, 849, 769, 681, 591, 504, 4 27, 366, 323, 298/ 
C  N  ASPECT 

DATA   (L( I  I ,  1  =  976,  1027) / 

1  102.,  995,951,888,808,716,617,517,424,343,280,238,213, 

2  1O07,  977,925,852,760,657,547,440,342,260,198,157,134, 

3  98r>,   951  ,992,810,708,595  .476,  362,262,  181,  122,   85,  65, 

4  957,  019,954,763,653,531,404,286,186,109,  57,  28,  14/ 
C  S  ASPECT 

DATA    (L(I I ,1=1028,10791/ 

1  1C1B, 10  03,976,93  5,980,815,739,6  59,580,5  08,449,407,383, 

2  10C7,  906,976,946,904,851,788,719,649,582,526,486,462, 

3  9ao,    98? , 970, 949, 919, 879, e29, 771 ,709,648 ,596, 557,534, 

4  96'.,  962  ,957,945,926,898,860,813,760,705,657,620,597/ 
C  NNE   OR  NNK  ASPECT 

DATA   (L( 1  I , I =1080,11311/ 

1  1C2  ,  995,952,889,911,720,622,523,431,350,287,245,220, 

2  10'.  7,    977,927,853,766,666.559,454,357,276,213,  172,  148, 

3  9.0';,    0--2,  995, 815, 717, 608, 495, 385, 288, 206, 146, 107,  36, 

4  906,  92' ,  9">7, 77,3, 664, 549  ,432  ,320,224, 145,  89,  55.  38/ 
C  SSE  '1R   OSt.  ASPECT 

DAT:    (LI  1), 1  =  1132, 1183)/ 


1  1019,  1003,075,934,878,81  I ,735  ,654,574,502,442.401  .376, 

2  1009,    997,  9->7,  045,901  ,846,781  ,709,637,570,513,473,449, 

3  9°3,   995, 971, 949, 017, 873, 818, 756, 692.63C, 577, 538, 515, 

4  972.  968,961,947,925,892,848,795,738,682,633,596,573/ 
C  Nt  ;<o  '|W  ASPECT 

OATA   ( L( I  I , I =1184,12351/ 

1  102    ,  096,955,895,819,732,636,540,449,369,307,264,240, 

2  10.7,    03-, 934, 363, 785, 691, 590, 489, 396, 316, 254, 212, 188, 

3  186,  956,906,835,747,648,544,441,347,268,208,167,145, 

4  9'.0,     727, 874, 80C, 738, 607, 5C0, 397, 305, 227,  170,  132,  111/ 
C  SE  OR   SW  ASPFCT 

OATA   (LI  1  ),  1  =  1236,12871  / 

1  1"2 100  3,974,93  0,872 ,802 ,722,639,55  8,4  84,424,382,3  58, 

2  1013,1000,976,93  9,890.829,758,682,606,5  36,478,437,413, 

3  13:2.  902,973,944,903,851,789,719,648,582.526,486,462, 

4  986,  979,066,944,910,867,811,749,684,621.568,529,505/ 
C  FNC   (JR   WNW  ASPFCT 

DAT<   (L ( I  I ,  1=1288,13391/ 

1  102'.,  908,960,904,832,749,657,563,475,397,335,292,268, 

2  IG10,  987,946.897,813,727,633,538,448,370,308,266,242, 

3  994,  970,023,863,792,704,609,514,425,347,286,245,221, 

4  975,   95", 908, 847, 770, 682, 587, 492, 404, 328, 268,  228, 205/ 
C  ESE  UR  HSU  ASPECT 

DATA    (L( I ) , 1=1340,1391 1/ 

1  1021, 1003,970,92  3,861  , 787, 704, 617, 534, 4 58, 398,  355,331, 

2  1015,  999,970,927,870.802,723,641,561,487,428,386,362, 

3  1006,  992,967,928,876,813,740,662,584,513,455,414,389, 

4  995,  082,960,926,879,821,752,678,604,535,478,437,413/ 
C  E  OR  W  ASPECT 

DATA   (L(I), 1=1392, 1443)/ 

1  1021,1001,96  5,914,847,768,681,591,505,4  28,367,324,299, 

2  1014,  994,960,909,843,766,680,591,506,430,369,327,302, 

3  1003,  984,951,902,838,762,678,591,507,432,372,330,306, 

4  990,  972,940,892,831,753,675,590,508,434,375,334,310/ 
C*****LAT1 TUDE  44 

C  HORIZONTAL  SURFACE 

DATA    (L( I ) ,1=14 44, 14 561/ 
1   K2  4, 1031,963,907,8  35,751,659,565,476,398,336,293,268/ 
C  N  ASPECT 

OATA   (L( I  I ,  1=1457,15081/ 

1  1018,  991,944,877,792,696,593,490.395.314,251,208,184, 

2  1303,  971,916,838,742,635,521,411,313,230,169,129,107, 

3  99C,  943,881,794,688,571,448,332,232,152,   96,   61,  43, 

4  949,   009,841,746,631,505,375,256,157,   83,   35,   11,  2/ 
C  S  ASPECT 

DATA   IL(I1. 1-1509, 15601/ 

1  1021,1004,974,92  9,870,800,719,636,554,480.419,377, 352, 

2  1012.  999,977,943,897,839,771,698,624,555.497,456,431, 

3  996,  988,973,949,914,870,815,752,686,622,568,527,503, 

4  975,  071,963,948,924,892,849,797,739,681,633,591,567/ 
C  NNE   OR   NNW  ASPECT 

DATA  (LI  I  I , 1  =  1561,16121/ 

1  1013.  991,945,878,795,700,598,496,402,321,258,215,191, 

2  1003,  972,918,842,749,644,533,425,328,246,184,144,121, 

3  980,   944,834,800,697,584,468,357,258,178,119,   82.  63, 

4  949,   910,345,753,643,524,404,292,195,119,  66,  35,  20/ 
C  SSE  OR  SSW  ASPECT 

DATA   (LI  I ), I =1613,16641/ 

1  1021, 1004,973,928,868,796,715,630.548,473,413,371,346, 

2  1013, 1000,977,942,893,834,763,688,612,542,485,443,418, 

3  999,  991,974,948,911,863,804,737,669,604,549,509,484, 

4  981,  976,966,949,922,885,836,778,717,657,606,567,5*3/ 
C  HE   OR   NW  ASPECT 

DATA   <L( I ), 1=1665,1716)/ 

1  1018,   993, 948, 885, 804, 712, 613, 513, 420. 340, 277, 235.  211, 

2  1004,  975,926,856,769,670,565,462,367,287,225,184,160, 

3  982,  950,897,822,730,627,519,414,319,240,180,141,119, 
*     953,   920,864.785,690,585,475,371,278,201,145,108,  88/ 

C  SE  OP   SW  ASPECT 

DATA   (L(I), 1=1717, 17681/ 

1  102  2, 1004,971,923,861,786,702,615,531,4  56,395,352,327, 

2  101 7, 1002,975,935,881 ,816,740,660,581,509,449,407,382, 

3  1307,   996, 974, 942, 896, 840, 772, 699, 625, S55, 498, 457,432, 

4  994,  985,969,944,906,857,798,731,661,596,540,500,476/ 
C  ENE  OR  WNW  ASPECT 

DATA    (L( I ) ,1=1 76 9, 1820)/ 

1  102:,  996,954,894,818,730,634,538,447,368,305,262.238, 

2  1000,  983,940,877,798,708,610,512,420,341,279,237,213, 

3  993,  966,922,857,777,685,587,488,398,319,258,217,194, 

4  973,  946,001,836,755,664,565,468,378,301,242,202,180/ 
C  E  SE  PR  WSW  ASPECT 

DATA   (L(I>, 1-1821, 18721/ 

1  1022, 1002,967,915,849,770,683,593,507,430,368,325,301, 

2  1019,1000,068,921,860,787,704,618,535,459,399,356,331, 

3  1C1J,  994,966,924,868,800,722,640,560,486,426,384,359, 

4  103:,  936,961,923,872,809,736,658,581,509,451,409,384/ 
C  F  OR  W  ASPECT 

OATA    (LI  I  I , I =1873,1924)/ 

1  1021,  999,961,905,834,751,659,566,477,399,337,294,270, 

2  1014,  993,955,901,831,749,659,566,479,401,340,297,273, 

3  IO04,  084,947,894,826,746,658,567,481,404,344,301,277, 

4  992,  372,937,886,820.742,656,568,483,408,348,306,282/ 
C  tF   ALL   ARE   BLANK,   READ  THE    INFORMATION  FROH  CARDS 

IFILAT. iO.O. AND. ASPECT. E0.3H       . AND. SLOPE. EO.O I   GO  TO  330 

C  FIND   THE   LATITUDE   IN  THF  TABLE 

I F ( L  A T  -  381  10,20,30 
10  WRITE   16,910)  LAT 
910  FORM AT(*0LATITUUE*I3»*  NOT  FOUNO  IN  RADIATION  TABLE   (SUBROUTINE  GF. 
1TP.1T  )«  I 
CALL   PR ABC  T 

C  LATITUDE   38    (L(l)   -  L(481l) 

20  LI   =  1 

GO  T'J  93 
30  IFILAT  -  40)  10,40.50 

C  LATITUDE  4C   (LI482)   -  LI062I) 

40  LI  =  432 
GO  TO  90 
50  IFILAT  -  42)  10,60,70 

C  LAT1TUD;    42    ILI963)    -  LI1443II 

60  LI  =  961 
GO  TO  90 
7C    IFILAT    -    441  10,30,10 

C  LATI TUO?  44   (L(14441  -  L(192*)l 

80   LI    =  1444 

C  FI-JD    THF  ASPICT 

90   IFIASPFCT.ME.3HN     I   GO  TO  100 
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L2   =  LI  ♦  13 
GO  TO  21C 
100  IFIASPECT.NE.3HS     I  GO  TO  110 
L 2  a  LI  ♦  65 
GO  TO  210 

110    IFIASPECT.NE.3HNNE .  AND.  ASPECT  .  NE  .  3HNNW  )    GO  TO  120 
L2  =  LI   ♦  117 
GO  TO  210 

120   IFIASPECT.NE.3HSSE.  AND.  ASPECT.  NE.3HSSWI   GO  TO  130 
L2   =    LI    ♦  169 

GO  TO  210 

130  IF( ASPECT. NE . 3HNE  . AND . ASPEC T. NE . 3HNW  I  GO  TO  1*0 
L2  =  LI  ♦  221 
GO  TO  210 

1*0  IFIASPECT.NE.3HSE   .AND. ASPECT. NE.3HSW   I   GO  TO  150 
L2  =■  11  ♦  273 
GO  TO  210 

150  I F ( A SPECT. NE . 3HENE. AND. ASPECT. NE. 3HWNW I   GO  TO  160 
L2  =  LI  ♦  325 
GO  TO  210 

160  !F(A SPECT. NE. 3HESE. AND. ASPECT. NE. 3HWSW I   GO  TO  170 
L2  -  LI  ♦  377 
GO  TO  210 

170  I F ( ASPEC  T.NE . 3HE     . AND. ASPECT . NE . 3HU     )   GO  TO  ISO 

L2  =  LI  ♦  *29 

GO  TO  210 
180  I  Ft  ASPECT.EO. 3H       I  GO  TO  190 

WRITE   16,9201  ASPECT 
920  FORHAT(«CASPECT  *A3,»  IS  INVALID*) 

CALL  PRABPT 

C  NO  ASPECT  IMPLIES  A  HORIZONTAL  SURFACE 

190  IF( SLOPE. EO.O)  GO  TO  200 

WRITE   16,930)  SLOPE 
930  FORMAT!*  WITH  A  SLOPE  0F*I3,*,   AN  ASPECT  MUST  BE  SUPPLIED,   BUT  NON 
IE  WAS  FOUND*) 
CALL  PRABRT 
200  L2  •  LI 
GO  TO  310 

C  FIND  THE  SLOPE  WITHIN  THE  TABLE 

210  IFISLOPE)  230.220 
220  WRITE   (6,9*01  ASPECT 

9*0  FORMAT  I *OWI TH  AN  ASPECT  OF  *A3,*,  A  ZERO  SLOPE  IS  INVALID*) 

CALL  PRABRT 
230  IF ( SLOPE  -  10)  2*0,310,250 
2*0  WRITE  (6,950)  SLOPE 
950  FORMAT(*0SLOPE*I3,»  IS  INVALID*) 

CALL  PRABRT 
250  IF(SLOPE  -  20)  2*0,260,270 
260  L2  •  L2  ♦  13 

GO  TO  310 
270  IF ( SLOPE  -  30)  2*0,280,290 
280  L2  =  L2  ♦  26 

GO  TO  310 
290  IFISLOPE  -  *0>  2*0,300,2*0 
300  L2  »  L2  ♦  39 

C  STORE  THE  VALUES  AT  THE  HORIZONTAL  SURFACE  ANO  COMPUTE  THE 

C   PERCENTAGE  WHICH  IS  INCIDENT  TO  THE  SLOPE 

310  LI  =  LI  -  1 

L2  =  12  -  1 

DO  320  I  =■  1,13 

J  -  I  ♦  11 

POTENTUI  »  LILl+i) 

SLPASP(J)  =■  FLOAT  (L  IL2+I I  ) /POTENT!  J) 
320  CONTINUE 
GO  TO  3*0 

C  READ  THE  CARDS  RATHER  THAN  USING  THE  TABLE 

330  READ  15,960)  NAME , I  POTENT ( I ) , 1-12,2*) ,NAME1, ( SLPASP I  1 1 , 1-12, 2*) 
960  FORMAT(A10,5X13F5.0/A10,5X13FS.2> 

IF ( NAME .EO. 10HPOTENTI AL  • AND. NAME 1 • EO. 10HSL0PE/ ASPE )  GO  TO  3*0 
WRITE  16,970)  NAHE.NAMEl 
970  FORMATI*0SINCE  THE  LATITUDE,  ASPECT  AND  SLOPE  WERE  NOT  SPECIFIED, 
1THE  -POTENTIAL  RAD-  AND  -SLOPE/ ASPECT-  CARDS  WERE  EXPECTED.*/ 

2  *0HOWEVER,  COL  1-10  OF  THE  TWO  CARDS  CONTAIN  -*A10,»-  AND  -*A10, 

3  *-.«) 
CALL  PRABPT 

C  FILL  THE  LOWER  PORTION  OF  THE  ARRAYS 

3*0  DO  350   I   =  1,11 

POTENTUI  =  P0TENT(2*-I  I 

SLPASPdl   -  SLPASP(2*-I) 
350  CONTINUE 

WRITE   (19)   POTENT, SLPASP 

RETURN 

END 


t   REC0VR,REGI0N(8I ,RFG0PT(5I , S AVE , S EDRN2 , WE IGHT 

INTEGER  DATIME,PLNOPT,PLUNIT,RECOVR, REGION, REGOPT, SAVE, SEDRN2 

DI MENS  I  ON  DEC IDi ( 31 , E  TDAL V ( 121 , A IRTMCI *) 

INTFGFR  ASPFCT, SLOPE, VEGTYP 
C  READ   THE    SUBSTATION  CONSTANTS 

READ  (  5,9201  NAME .TCOEFF , COVOEN , CDMAX , VEGTYP , TRSHLO, TMPMLT , W I L TPT , 
1   DECIDS,L4T, ASPECT, SLOPE 

920  FORMAT(Aln,10X3F5.2,4XIl,2F5.0,*F5.2,lXI2,lXA3,lXI2l 
IFINAME.EO. 1GHSUBSTATI0N)   GO  TO  20 

WRITE    (6,9211  PLUNIT 

921  FORMAT ( *OTHE  SUBSTATION  CONSTANTS  CARO  DOES  NOT  FOLLOW  THE  SU8STAT 
HON    10   CAF  D  6NTITLEO*/1X6A10) 

CALL  PRABRT 

C  ENSURE   THAT  THE   WILTING  POINT   IS  NEGATIVE 

20  WILTPT  =  -ABS  (WILTPT) 
C  CONVERT  THE   MELT  THRESHOLO  TO  CENTIGRADE 

TMPMLT  =  ( TMPMLT  -  32.0)   •  0.55555555555  555 

IFICDMAX.GE.COVDEN. AND. COVDEN.GE. 0.01   GO  TO  30 

WRITE    16,9221   PLUNI T ,C OVDEN ,CDHAX 

922  FORM  AT ( *0ON  THE   SUBSTATION   10  CARD  ENTITLED  *6A10/«  THE  COVER  DENS 
1ITY  SPECIFIED  IN  COLUMNS  26-30  (»F5.2,*I   IS  EITHER  NEGATIVE  OR  IT 
2IS   GREATER    THAN    THE   MAXIMUM  COVER  DENSITY*/*        IN  COLUMNS    31-35  I* 
3F5.2.*)*) 

CALL  PRABRT 
30  IFIVEGTYP.EQ.1.0R.VEGTYP.EQ.2)  GO  TO  60 
IFI VEGTYP. EO. 3)   GO  TO  *0 

IFICOVDEN.EO. 0.0. AND. VEGTYP. EO.O).  GO  TO  60 
WRITE   (6,9231   VEGTYP, PLUNIT 

923  FORMAT(«0INVALI0  VEG  TYPE  (»U,*I  IN  COLUMN  *0  OF  SUBSTATION  ID  CA 
1RD  ENTITLED  *6A10/*  VEGETATION  TYPE  >  1  (LOOGEPOLE  PINE),  =  2  (SPR 
2UCE  FIR),  =  3  (DECIDUOUS)*) 

CALL  PRABRT 

C  DECIDUOUS  FOREST  -  CHECK  THE  WINTER  VALUES  FOR  COVER  OENSITY  AND 

C   TRANSMISSIVITY  COEFFICIENT 

*0  IF(DECI0SI3I.GE.DECIOS(2I.AND.OECIDS(2).GT.0.0)  GO  TO  60 
WRITE   (6,92*1   PLUNIT, DEC  I DS 1 2 1 , DEC  I DS ( 3 ) 
92*  FORMAT! *00N  THE  SUBSTATION  ID  CARD  ENTITLED  *6A10/*  THE  COVER  DENS 
1ITY  SPECIFIED  IN  COLUMNS  61-65  (*F5.2,*>   IS  EITHER  NEGATIVE  OR  IT 
2IS  GREATER  THAN  THE  MAXIMUM  COVER  OENSITY*/*       IN  COLUMNS  66-70  I* 
1F5.2,*)*) 
CALL  PRABRT 

C  READ  THE  INITIAL  CONDITIONS  CARD 

60  READ   (5,930)   NAME , SI MTH1 .PREWEQ, RECHRG 

930  FORMATIA10.10X3F5.2) 
IFINAME.EO. 10HINITIAL  CO)   GO  TO  70 
WRITE   (6,931)  PLUNIT 

931  FORMAT ( *OTHE  INITIAL  CONDITIONS  CARD  DOES  NOT  FOLLOW  THE  SUBSTATIO 
IN  CONSTANTS  CARD  IN  THE  CARDS  FOLLOWING  THE  SUBSTATION  ID  CARD  ENT 
2ITLED*/1X6A10) 

CALL  PRABRT 

C  READ  THE  OAILY  ET  VALUES 

70  READ   15,9*0)  NAME.ETOALY 
940  F0RMATIA10,10X12F5.*) 

IFINAME.EO. 10HDAILY  ET     )   GO  TO  80 
WRITE  16,9*1)  PLUNIT 
9*1  FORMATI*OTHE  DAILY  ET  VALUES  CARD  DOES  NOT  FOLLOW  THE  INITIAL  COND 
1ITI0NS  CARD  IN  THE  CARDS  FOLLOWING  THE  SUBSTATION  10  CARD  ENTITLED 
2«/lX6A10l 
CALL  PRABRT 
80  READ   (5,950)   NAME, AIRTMC, SUMMER 

950  FORMATIA10.10X5F5.3) 
IFINAME.EO. 10HAIR  TEMP  C)  GO  TO  90 
WRITE   (6,951)  PLUNIT 

951  FORMAT ( *OTHE  AIR  TEMPERATURE  COEFFICIENTS  CARD  OOES  NOT  FOLLOW  THE 
1  DAILY  ET  CARO  IN  THE  CARDS  FOLLOWING  THE  SUBSTATION  ID  CARO  ENTIT 
2LED*/1X6A10I 

CALL  PRABRT 
90  IF(SUMMER.LE.O.O)   SUMMER  =  1.0 

WRITE   (19)   TCOEFF, COVDEN .COMAX , VEGTYP. TRSHLO, TMPMLT, WILTPT, DEC I0S, 
1  L AT, ASPECT, SLOPE, S I MT Ml, PREWEQ, RECHRG, ETOALY, AIRTMC. SUMMER 
C  GET  THE  POTENTIAL  RADIATION  ANO  THE  ADJUSTMENT  FACTORS 

CALL   GETPOT   ( LAT , ASPEC  T , SLOPE ) 
C  READ  THE  FORMAT-INDICES  CARD 

CALL  GETFHT 

RETURN 

END 


Subroutine  PRABRT 


Subroutine  PARAMS 


SUBROUTINE  PARAMS 
-READ  THE  PARAMETER  DECK 
COMMON  DATIMEI2) .OECMAL .NRMANG , NS AVEO ,NYF ARS , PLNOPT ( 19 ) , PLUN IT  I  6  I  , 


SUBROUTINE  PRABRT 

C  PRE- ABOR  T   THE  RUN 

WRITE  (6,910) 

910  FORMAT(*0J0B  PRf-ABORTED  BY  A  PARAMETER  OECK   PROOFREADING  ROUTINE 
1-  NO   SIMULATIONS  WERE   PERFORMED  ON  ANY  OF  THE  PLANNING  UNITS*) 
REWIND  13 
END  FILE  13 
CALL  ABORT 
END 
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